OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes] 

2014-06-11  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_prag.adb (Analyze_Input_Item): Allow formal
	parameters to appear as input_items in an initialization_list
	of pragma Initializes. Encapsulation now applies to states and
	variables only (as it should). Add RM references to key errors.
	* sem_prag.adb (Set_Imported): Suppress errors
	about preceding Imports when the pragma does not come from source,
	which can happen through use of pragma Provide_Shift_Operators.

2014-06-11  Thomas Quinot  <quinot@adacore.com>

	* sem_ch3.adb: Minor reformatting.
	* einfo.ads (Full_View): Minor comment update.

From-SVN: r211460
This commit is contained in:
Arnaud Charlet 2014-06-11 14:42:28 +02:00
parent e9daba5169
commit 40f4dbbe62
4 changed files with 191 additions and 92 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
gcc/ada/ChangeLog
View File

@ -1,3 +1,40 @@
2014-06-11 Hristian Kirtchev <kirtchev@adacore.com>
* sem_prag.adb (Analyze_Input_Item): Allow formal
parameters to appear as input_items in an initialization_list
of pragma Initializes. Encapsulation now applies to states and
variables only (as it should). Add RM references to key errors.
* sem_prag.adb (Set_Imported): Suppress errors
about preceding Imports when the pragma does not come from source,
which can happen through use of pragma Provide_Shift_Operators.
2014-06-11 Thomas Quinot <quinot@adacore.com>
* sem_ch3.adb: Minor reformatting.
* einfo.ads (Full_View): Minor comment update.
2014-06-11 Robert Dewar <dewar@adacore.com>
* einfo.adb (Is_Independent): New flag.
* einfo.ads (Is_Independent): New flag.
(Has_Independent_Components): Clean up and fix comments.
* sem_prag.adb (Fix_Error): Deal with changing argument
[of] to entity [for].
(Analyze_Pragma, case Independent): Set Is_Independent flag
(Analyze_Pragma, case Independent_Components): Set Is_Independent flag
in all components of specified record.
2014-06-11 Thomas Quinot <quinot@adacore.com>
* sem_ch12.adb (Analyze_Formal_Decimal_Fixed_Point_Type):
Set proper Etype on bounds of dummy type created for analysis
of the generic.
2014-06-11 Robert Dewar <dewar@adacore.com>
* debug.adb: Minor comment fix (add missing section of dot
numeric flags).
2014-06-11 Robert Dewar <dewar@adacore.com>
* gnat_rm.texi, switch-c.adb, sem_prag.adb, a-tgdico.ads, par-prag.adb,

38
gcc/ada/einfo.ads
View File

@ -1336,12 +1336,12 @@ package Einfo is
-- Full_View (Node11)
-- Defined in all type and subtype entities and in deferred constants.
-- References the entity for the corresponding full type declaration.
-- For all types other than private and incomplete types, this field
-- always contains Empty. If an incomplete type E1 is completed by a
-- private type E2 whose full type declaration entity is E3 then the
-- full view of E1 is E2, and the full view of E2 is E3. See also
-- Underlying_Type.
-- References the entity for the corresponding full type or constant
-- declaration. For all types other than private and incomplete types,
-- this field always contains Empty. If an incomplete type E1 is
-- completed by a private type E2 whose full type declaration entity is
-- E3 then the full view of E1 is E2, and the full view of E2 is E3. See
-- also Underlying_Type.
-- Generic_Homonym (Node11)
-- Defined in generic packages. The generic homonym is the entity of
@ -1581,9 +1581,11 @@ package Einfo is
-- Implicit_Dereference. Set also on the discriminant named in the aspect
-- clause, to simplify type resolution.
-- Has_Independent_Components (Flag34)
-- Defined in objects and types. Set if the aspect Independent_Components
-- applies (as set by coresponding pragma or aspect specification).
-- Has_Independent_Components (Flag34) [base type only]
-- Defined in types. Set if the aspect Independent_Components applies
-- (in the base type only), if corresponding pragma or aspect applies.
-- In the case of an object of anonymous array type, the flag is set on
-- the created array type.
-- Has_Inheritable_Invariants (Flag248)
-- Defined in all type entities. Set in private types from which one
@ -2415,6 +2417,11 @@ package Einfo is
-- Is_Incomplete_Type (synthesized)
-- Applies to all entities, true for incomplete types and subtypes
-- Is_Independent (Flag268)
-- Defined in record components. Set if a valid pragma or aspect
-- Independent applies to the component, or if a valid pragma or aspect
-- Independent_Components applies to the enclosing record type.
-- Is_Inlined (Flag11)
-- Defined in all entities. Set for functions and procedures which are
-- to be inlined. For subprograms created during expansion, this flag
@ -4215,7 +4222,7 @@ package Einfo is
-- In addition, we define the kind E_Allocator_Type to label allocators.
-- This is because special resolution rules apply to this construct.
-- Eventually the constructs are labeled with the access type imposed by
-- the context. Gigi should never see the type E_Allocator.
-- the context. Gigi should never see types with this Ekind.
-- Similarly, the type E_Access_Attribute_Type is used as the initial kind
-- associated with an access attribute. After resolution a specific access
@ -4398,8 +4405,8 @@ package Einfo is
-- 'Unrestricted_Access and Unchecked_Access)
E_Allocator_Type,
-- A special internal type used to label allocators and attribute
-- references using 'Access. This is needed because special resolution
-- A special internal type used to label allocators and references to
-- objects using 'Reference. This is needed because special resolution
-- rules apply to these constructs. On the resolution pass, this type
-- is always replaced by the actual access type, so Gigi should never
-- see types with this Ekind.
@ -5350,6 +5357,7 @@ package Einfo is
-- Has_Biased_Representation (Flag139)
-- Has_Per_Object_Constraint (Flag154)
-- Is_Atomic (Flag85)
-- Is_Independent (Flag268)
-- Is_Tag (Flag78)
-- Is_Volatile (Flag16)
-- Treat_As_Volatile (Flag41)
@ -5379,7 +5387,6 @@ package Einfo is
-- Has_Atomic_Components (Flag86)
-- Has_Biased_Representation (Flag139)
-- Has_Completion (Flag26) (constants only)
-- Has_Independent_Components (Flag34) (base type only)
-- Has_Thunks (Flag228) (constants only)
-- Has_Size_Clause (Flag29)
-- Has_Up_Level_Access (Flag215)
@ -6089,7 +6096,6 @@ package Einfo is
-- Has_Alignment_Clause (Flag46)
-- Has_Atomic_Components (Flag86)
-- Has_Biased_Representation (Flag139)
-- Has_Independent_Components (Flag34) (base type only)
-- Has_Initial_Value (Flag219)
-- Has_Size_Clause (Flag29)
-- Has_Up_Level_Access (Flag215)
@ -6589,6 +6595,7 @@ package Einfo is
function Is_Immediately_Visible (Id : E) return B;
function Is_Implementation_Defined (Id : E) return B;
function Is_Imported (Id : E) return B;
function Is_Independent (Id : E) return B;
function Is_Inlined (Id : E) return B;
function Is_Instantiated (Id : E) return B;
function Is_Interface (Id : E) return B;
@ -7217,6 +7224,7 @@ package Einfo is
procedure Set_Is_Immediately_Visible (Id : E; V : B := True);
procedure Set_Is_Implementation_Defined (Id : E; V : B := True);
procedure Set_Is_Imported (Id : E; V : B := True);
procedure Set_Is_Independent (Id : E; V : B := True);
procedure Set_Is_Inlined (Id : E; V : B := True);
procedure Set_Is_Instantiated (Id : E; V : B := True);
procedure Set_Is_Interface (Id : E; V : B := True);
@ -7979,6 +7987,7 @@ package Einfo is
pragma Inline (Is_Imported);
pragma Inline (Is_Incomplete_Or_Private_Type);
pragma Inline (Is_Incomplete_Type);
pragma Inline (Is_Independent);
pragma Inline (Is_Inlined);
pragma Inline (Is_Instantiated);
pragma Inline (Is_Integer_Type);
@ -8426,6 +8435,7 @@ package Einfo is
pragma Inline (Set_Is_Immediately_Visible);
pragma Inline (Set_Is_Implementation_Defined);
pragma Inline (Set_Is_Imported);
pragma Inline (Set_Is_Independent);
pragma Inline (Set_Is_Inlined);
pragma Inline (Set_Is_Instantiated);
pragma Inline (Set_Is_Interface);

1
gcc/ada/sem_ch3.adb
View File

@ -15508,7 +15508,6 @@ package body Sem_Ch3 is
or else No (Full_View (Prev))
or else not Is_Private_Type (Full_View (Prev)))
then
-- Indicate that the incomplete declaration has a matching full
-- declaration. The defining occurrence of the incomplete
-- declaration remains the visible one, and the procedure

207
gcc/ada/sem_prag.adb
View File

@ -2583,8 +2583,12 @@ package body Sem_Prag is
if Is_Entity_Name (Input) then
Input_Id := Entity_Of (Input);
if Ekind_In (Input_Id, E_Abstract_State, E_Variable) then
if Ekind_In (Input_Id, E_Abstract_State,
E_In_Parameter,
E_In_Out_Parameter,
E_Out_Parameter,
E_Variable)
then
-- The input cannot denote states or variables declared
-- within the related package.
@ -2610,13 +2614,15 @@ package body Sem_Prag is
Add_Item (Input_Id, States_Seen);
end if;
if Present (Encapsulating_State (Input_Id)) then
if Ekind_In (Input_Id, E_Abstract_State, E_Variable)
and then Present (Encapsulating_State (Input_Id))
then
Add_Item (Input_Id, Constits_Seen);
end if;
end if;
-- The input references something that is not a state or a
-- variable.
-- variable (SPARK RM 7.1.5(3)).
else
Error_Msg_N
@ -2624,6 +2630,7 @@ package body Sem_Prag is
end if;
-- Some form of illegal construct masquerading as a name
-- (SPARK RM 7.1.5(3)).
else
Error_Msg_N
@ -3219,14 +3226,27 @@ package body Sem_Prag is
-- procedure identified by Name, returns it if it exists, otherwise
-- errors out and uses Arg as the pragma argument for the message.
procedure Fix_Error (Msg : in out String);
-- This is called prior to issuing an error message. Msg is a string
-- that typically contains the substring "pragma". If the pragma comes
-- from an aspect, each such "pragma" substring is replaced with the
-- characters "aspect", and Error_Msg_Name_1 is set to the name of the
-- aspect (which may be different from the pragma name). If the current
-- pragma results from rewriting another pragma, then Error_Msg_Name_1
-- is set to the original pragma name.
function Fix_Error (Msg : String) return String;
-- This is called prior to issuing an error message. Msg is the normal
-- error message issued in the pragma case. This routine checks for the
-- case of a pragma coming from an aspect in the source, and returns a
-- message suitable for the aspect case as follows:
--
-- Each substring "pragma" is replaced by "aspect"
--
-- If "argument of" is at the start of the error message text, it is
-- replaced by "entity for".
--
-- If "argument" is at the start of the error message text, it is
-- replaced by "entity".
--
-- So for example, "argument of pragma X must be discrete type"
-- returns "entity for aspect X must be a discrete type".
-- Finally Error_Msg_Name_1 is set to the name of the aspect (which may
-- be different from the pragma name). If the current pragma results
-- from rewriting another pragma, then Error_Msg_Name_1 is set to the
-- original pragma name.
procedure Gather_Associations
(Names : Name_List;
@ -3746,12 +3766,11 @@ package body Sem_Prag is
Error_Msg_Name_1 := Pname;
declare
Msg : String :=
Msg : constant String :=
"argument for pragma% must be a identifier or "
& "static string expression!";
begin
Fix_Error (Msg);
Flag_Non_Static_Expr (Msg, Argx);
Flag_Non_Static_Expr (Fix_Error (Msg), Argx);
raise Pragma_Exit;
end;
end if;
@ -4419,15 +4438,9 @@ package body Sem_Prag is
else
Error_Msg_Name_1 := Pname;
declare
Msg : String :=
"argument for pragma% must be a static expression!";
begin
Fix_Error (Msg);
Flag_Non_Static_Expr (Msg, Expr);
end;
Flag_Non_Static_Expr
(Fix_Error ("argument for pragma% must be a static expression!"),
Expr);
raise Pragma_Exit;
end if;
end Check_Expr_Is_Static_Expression;
@ -5822,11 +5835,9 @@ package body Sem_Prag is
------------------
procedure Error_Pragma (Msg : String) is
MsgF : String := Msg;
begin
Error_Msg_Name_1 := Pname;
Fix_Error (MsgF);
Error_Msg_N (MsgF, N);
Error_Msg_N (Fix_Error (Msg), N);
raise Pragma_Exit;
end Error_Pragma;
@ -5835,20 +5846,16 @@ package body Sem_Prag is
----------------------
procedure Error_Pragma_Arg (Msg : String; Arg : Node_Id) is
MsgF : String := Msg;
begin
Error_Msg_Name_1 := Pname;
Fix_Error (MsgF);
Error_Msg_N (MsgF, Get_Pragma_Arg (Arg));
Error_Msg_N (Fix_Error (Msg), Get_Pragma_Arg (Arg));
raise Pragma_Exit;
end Error_Pragma_Arg;
procedure Error_Pragma_Arg (Msg1, Msg2 : String; Arg : Node_Id) is
MsgF : String := Msg1;
begin
Error_Msg_Name_1 := Pname;
Fix_Error (MsgF);
Error_Msg_N (MsgF, Get_Pragma_Arg (Arg));
Error_Msg_N (Fix_Error (Msg1), Get_Pragma_Arg (Arg));
Error_Pragma_Arg (Msg2, Arg);
end Error_Pragma_Arg;
@ -5857,11 +5864,9 @@ package body Sem_Prag is
----------------------------
procedure Error_Pragma_Arg_Ident (Msg : String; Arg : Node_Id) is
MsgF : String := Msg;
begin
Error_Msg_Name_1 := Pname;
Fix_Error (MsgF);
Error_Msg_N (MsgF, Arg);
Error_Msg_N (Fix_Error (Msg), Arg);
raise Pragma_Exit;
end Error_Pragma_Arg_Ident;
@ -5870,12 +5875,10 @@ package body Sem_Prag is
----------------------
procedure Error_Pragma_Ref (Msg : String; Ref : Entity_Id) is
MsgF : String := Msg;
begin
Error_Msg_Name_1 := Pname;
Fix_Error (MsgF);
Error_Msg_Sloc := Sloc (Ref);
Error_Msg_NE (MsgF, N, Ref);
Error_Msg_Sloc := Sloc (Ref);
Error_Msg_NE (Fix_Error (Msg), N, Ref);
raise Pragma_Exit;
end Error_Pragma_Ref;
@ -6006,7 +6009,11 @@ package body Sem_Prag is
-- Fix_Error --
---------------
procedure Fix_Error (Msg : in out String) is
function Fix_Error (Msg : String) return String is
Res : String (Msg'Range) := Msg;
Res_Last : Natural := Msg'Last;
J : Natural;
begin
-- If we have a rewriting of another pragma, go to that pragma
@ -6022,16 +6029,47 @@ package body Sem_Prag is
-- Change appearence of "pragma" in message to "aspect"
for J in Msg'First .. Msg'Last - 5 loop
if Msg (J .. J + 5) = "pragma" then
Msg (J .. J + 5) := "aspect";
J := Res'First;
while J <= Res_Last - 5 loop
if Res (J .. J + 5) = "pragma" then
Res (J .. J + 5) := "aspect";
J := J + 6;
else
J := J + 1;
end if;
end loop;
-- Change "argument of" at start of message to "entity for"
if Res'Length > 11
and then Res (Res'First .. Res'First + 10) = "argument of"
then
Res (Res'First .. Res'First + 9) := "entity for";
Res (Res'First + 10 .. Res_Last - 1) :=
Res (Res'First + 11 .. Res_Last);
Res_Last := Res_Last - 1;
end if;
-- Change "argument" at start of message to "entity"
if Res'Length > 8
and then Res (Res'First .. Res'First + 7) = "argument"
then
Res (Res'First .. Res'First + 5) := "entity";
Res (Res'First + 6 .. Res_Last - 2) :=
Res (Res'First + 8 .. Res_Last);
Res_Last := Res_Last - 2;
end if;
-- Get name from corresponding aspect
Error_Msg_Name_1 := Original_Aspect_Name (N);
end if;
-- Return possibly modified message
return Res (Res'First .. Res_Last);
end Fix_Error;
-------------------------
@ -9538,6 +9576,12 @@ package body Sem_Prag is
elsif Import_Interface_Present (N) then
goto OK;
-- OK if the pragma was expanded by the compiler. Can occur when
-- using pragma Provide_Shift_Operators on multiple types.
elsif not Comes_From_Source (N) then
goto OK;
-- Error if being set Imported twice
else
@ -14974,13 +15018,11 @@ package body Sem_Prag is
-- Independent --
-----------------
-- pragma Independent (LOCAL_NAME);
-- pragma Independent (record_component_LOCAL_NAME);
when Pragma_Independent => Independent : declare
E_Id : Node_Id;
E : Entity_Id;
D : Node_Id;
K : Node_Kind;
begin
Check_Ada_83_Warning;
@ -14995,38 +15037,32 @@ package body Sem_Prag is
end if;
E := Entity (E_Id);
D := Declaration_Node (E);
K := Nkind (D);
-- Check we have a record component. We have not yet setup
-- components fully, so identify by syntactic structure.
if Nkind (Declaration_Node (E)) /= N_Component_Declaration then
Error_Pragma_Arg
("argument for pragma% must be record component", Arg1);
end if;
-- Check duplicate before we chain ourselves
Check_Duplicate_Pragma (E);
-- Check appropriate entity
-- Chain pragma
if Is_Type (E) then
if Rep_Item_Too_Early (E, N)
or else
Rep_Item_Too_Late (E, N)
then
return;
else
Check_First_Subtype (Arg1);
end if;
elsif K = N_Object_Declaration
or else (K = N_Component_Declaration
and then Original_Record_Component (E) = E)
if Rep_Item_Too_Early (E, N)
or else
Rep_Item_Too_Late (E, N)
then
if Rep_Item_Too_Late (E, N) then
return;
end if;
else
Error_Pragma_Arg
("inappropriate entity for pragma%", Arg1);
return;
end if;
-- Set flag in component
Set_Is_Independent (E);
Independence_Checks.Append ((N, E));
end Independent;
@ -15043,6 +15079,7 @@ package body Sem_Prag is
E : Entity_Id;
D : Node_Id;
K : Node_Kind;
C : Node_Id;
begin
Check_Ada_83_Warning;
@ -15077,16 +15114,26 @@ package body Sem_Prag is
if K = N_Full_Type_Declaration
and then (Is_Array_Type (E) or else Is_Record_Type (E))
then
Independence_Checks.Append ((N, E));
Independence_Checks.Append ((N, Base_Type (E)));
Set_Has_Independent_Components (Base_Type (E));
-- For record type, set all components independent
if Is_Record_Type (E) then
C := First_Component (E);
while Present (C) loop
Set_Is_Independent (C);
Next_Component (C);
end loop;
end if;
elsif (Ekind (E) = E_Constant or else Ekind (E) = E_Variable)
and then Nkind (D) = N_Object_Declaration
and then Nkind (Object_Definition (D)) =
N_Constrained_Array_Definition
then
Independence_Checks.Append ((N, E));
Set_Has_Independent_Components (E);
Independence_Checks.Append ((N, Base_Type (Etype (E))));
Set_Has_Independent_Components (Base_Type (Etype (E)));
else
Error_Pragma_Arg ("inappropriate entity for pragma%", Arg1);
@ -17426,8 +17473,15 @@ package body Sem_Prag is
Check_No_Identifiers;
Check_Arg_Count (1);
Check_Arg_Is_Local_Name (Arg1);
Type_Id := Get_Pragma_Arg (Assoc);
if not Is_Entity_Name (Type_Id)
or else not Is_Type (Entity (Type_Id))
then
Error_Pragma_Arg
("argument for pragma% must be type or subtype", Arg1);
end if;
Find_Type (Type_Id);
Typ := Entity (Type_Id);
@ -19650,13 +19704,12 @@ package body Sem_Prag is
--------------------------------
procedure Check_Library_Level_Entity (E : Entity_Id) is
MsgF : String := "incorrect placement of pragma%";
MsgF : constant String := "incorrect placement of pragma%";
begin
if not Is_Library_Level_Entity (E) then
Error_Msg_Name_1 := Pname;
Fix_Error (MsgF);
Error_Msg_N (MsgF, N);
Error_Msg_N (Fix_Error (MsgF), N);
if Ekind_In (E, E_Generic_Package,
E_Package,