procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

sem_prag.adb (Analyze_PPC_In_Decl_Part): Pre'Class and Post'Class aspects can only be specified for a primitive...

Browse source 
2012-02-17  Steve Baird  <baird@adacore.com>

	* sem_prag.adb (Analyze_PPC_In_Decl_Part): Pre'Class and
	Post'Class aspects can only be specified for a primitive operation
	of a tagged type.

From-SVN: r184342
This commit is contained in:
Steve Baird 2012-02-17 14:17:21 +00:00 • committed by Arnaud Charlet
parent 794b9b7240
commit acf49e88aa
2 changed files with 47 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
gcc/ada/ChangeLog
View file

@ -1,3 +1,9 @@
2012-02-17 Steve Baird <baird@adacore.com>
* sem_prag.adb (Analyze_PPC_In_Decl_Part): Pre'Class and
Post'Class aspects can only be specified for a primitive operation
of a tagged type.
2012-02-17 Yannick Moy <moy@adacore.com>
* gnat_rm.texi: Minor shuffling.

43
gcc/ada/sem_prag.adb
View file

@ -278,13 +278,19 @@ package body Sem_Prag is
-- overriding operation (see ARM12 6.6.1 (7)).
if Class_Present (N) then
declare
Class_Wide_Condition : declare
T : constant Entity_Id := Find_Dispatching_Type (S);
ACW : Entity_Id := Empty;
-- Access to T'class, created if there is a controlling formal
-- that is an access parameter.
function Aspect_Name return String;
-- Return the name of the aspect being specified ("Pre" or "Post")
-- properly capitalized for use in an error message. Precondition
-- is Present (Corresponding_Aspect (N)), which will be satisfied
-- if Class_Present (N).
function Get_ACW return Entity_Id;
-- If the expression has a reference to an controlling access
-- parameter, create an access to T'class for the necessary
@ -299,6 +305,19 @@ package body Sem_Prag is
-- type access-to-T'Class. This ensures the expression is well-
-- defined for a primitive subprogram of a type descended from T.
-----------------
-- Aspect_Name --
-----------------
function Aspect_Name return String is
begin
if Chars (Identifier (Corresponding_Aspect (N))) = Name_Pre then
return "Pre";
else
return "Post";
end if;
end Aspect_Name;
-------------
-- Get_ACW --
-------------
@ -365,9 +384,29 @@ package body Sem_Prag is
procedure Replace_Type is new Traverse_Proc (Process);
-- Start of processing for Class_Wide_Condition
begin
if not Present (T) then
-- This is weird code, why not just set Err_Msg_Name_1 to
-- Identifier (Corresponding_Aspect (N)), and Err_Msg_Name_2
-- to Name_Class and then use
-- "aspect `%''%` can only be specified ...
-- That would be the more normal way of doing things ???
-- Then you get proper identifier casing mode as well,
-- instead of presuming mixed case ???
Error_Msg_N
("aspect " & Aspect_Name & "''Class can only be specified " &
"for a primitive operation of a tagged type",
Corresponding_Aspect (N));
end if;
Replace_Type (Get_Pragma_Arg (Arg1));
end;
end Class_Wide_Condition;
end if;
-- Remove the subprogram from the scope stack now that the pre-analysis