Commit 3f8c04e7 by Arnaud Charlet

[multiple changes]

2015-10-27  Javier Miranda  <miranda@adacore.com>

	* sem_util.ads, sem_util.adb (Defining_Identifier): Adding a formal to
	indicate the needed behavior in case of nodes with errors.

2015-10-27  Ed Schonberg  <schonberg@adacore.com>

	* sem_attr.adb (Eval_Attribute): If the prefix of attribute
	Enum_Rep is an object that is a generated loop variable for an
	element iterator, no folding is possible.
	* sem_res.adb (Resolve_Entity_Name): Do not check for a missing
	initialization in the case of a constant that is an object
	renaming.
	* exp_attr.adb (Expand_N_Attribute_Reference, case Enum_Rep):
	If the prefix is a constant that renames an expression there is
	nothing to evaluate statically.

2015-10-27  Vincent Celier  <celier@adacore.com>

	* gnatlink.adb: Always delete the response file, even when the
	invocation of gcc to link failed.

2015-10-27  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_ch6.adb (Analyze_Subprogram_Body_Helper):
	Do not inherit the SPARK_Mode from the context if it has been
	set already.
	(Build_Subprogram_Declaration): Relocate relevant
	pragmas from the subprogram body to the generated corresponding
	spec. Do not copy aspect SPARK_Mode as this leads to circularity
	in Copy_Separate_Tree. Inherit the attributes that describe
	pragmas Ghost and SPARK_Mode.
	(Move_Pragmas): New routine.

From-SVN: r229421
parent 2bfad6eb
2015-10-27 Javier Miranda <miranda@adacore.com>
* sem_util.ads, sem_util.adb (Defining_Identifier): Adding a formal to
indicate the needed behavior in case of nodes with errors.
2015-10-27 Ed Schonberg <schonberg@adacore.com>
* sem_attr.adb (Eval_Attribute): If the prefix of attribute
Enum_Rep is an object that is a generated loop variable for an
element iterator, no folding is possible.
* sem_res.adb (Resolve_Entity_Name): Do not check for a missing
initialization in the case of a constant that is an object
renaming.
* exp_attr.adb (Expand_N_Attribute_Reference, case Enum_Rep):
If the prefix is a constant that renames an expression there is
nothing to evaluate statically.
2015-10-27 Vincent Celier <celier@adacore.com>
* gnatlink.adb: Always delete the response file, even when the
invocation of gcc to link failed.
2015-10-27 Hristian Kirtchev <kirtchev@adacore.com>
* sem_ch6.adb (Analyze_Subprogram_Body_Helper):
Do not inherit the SPARK_Mode from the context if it has been
set already.
(Build_Subprogram_Declaration): Relocate relevant
pragmas from the subprogram body to the generated corresponding
spec. Do not copy aspect SPARK_Mode as this leads to circularity
in Copy_Separate_Tree. Inherit the attributes that describe
pragmas Ghost and SPARK_Mode.
(Move_Pragmas): New routine.
2015-10-27 Hristian Kirtchev <kirtchev@adacore.com> 2015-10-27 Hristian Kirtchev <kirtchev@adacore.com>
* inline.adb (Is_Expression_Function): Removed. * inline.adb (Is_Expression_Function): Removed.
......
...@@ -2995,10 +2995,12 @@ package body Exp_Attr is ...@@ -2995,10 +2995,12 @@ package body Exp_Attr is
Make_Integer_Literal (Loc, Enumeration_Rep (Entity (Pref)))); Make_Integer_Literal (Loc, Enumeration_Rep (Entity (Pref))));
-- If this is a renaming of a literal, recover the representation -- If this is a renaming of a literal, recover the representation
-- of the original. -- of the original. If it renames an expression there is nothing
-- to fold.
elsif Ekind (Entity (Pref)) = E_Constant elsif Ekind (Entity (Pref)) = E_Constant
and then Present (Renamed_Object (Entity (Pref))) and then Present (Renamed_Object (Entity (Pref)))
and then Is_Entity_Name (Renamed_Object (Entity (Pref)))
and then Ekind (Entity (Renamed_Object (Entity (Pref)))) = and then Ekind (Entity (Renamed_Object (Entity (Pref)))) =
E_Enumeration_Literal E_Enumeration_Literal
then then
......
...@@ -1859,6 +1859,10 @@ begin ...@@ -1859,6 +1859,10 @@ begin
-- been compiled. -- been compiled.
if Opt.CodePeer_Mode then if Opt.CodePeer_Mode then
if Tname_FD /= Invalid_FD then
Delete (Tname);
end if;
return; return;
end if; end if;
...@@ -2052,16 +2056,14 @@ begin ...@@ -2052,16 +2056,14 @@ begin
System.OS_Lib.Spawn (Linker_Path.all, Args, Success); System.OS_Lib.Spawn (Linker_Path.all, Args, Success);
if Success then -- Delete the temporary file used in conjunction with linking if one
-- was created. See Process_Bind_File for details.
-- Delete the temporary file used in conjunction with linking if Tname_FD /= Invalid_FD then
-- if one was created. See Process_Bind_File for details. Delete (Tname);
end if;
if Tname_FD /= Invalid_FD then
Delete (Tname);
end if;
else if not Success then
Error_Msg ("error when calling " & Linker_Path.all); Error_Msg ("error when calling " & Linker_Path.all);
Exit_Program (E_Fatal); Exit_Program (E_Fatal);
end if; end if;
......
...@@ -7286,9 +7286,14 @@ package body Sem_Attr is ...@@ -7286,9 +7286,14 @@ package body Sem_Attr is
if Is_Entity_Name (P) then if Is_Entity_Name (P) then
-- The prefix denotes a constant or an enumeration literal, the -- The prefix denotes a constant or an enumeration literal, the
-- attribute can be folded. -- attribute can be folded. A generated loop variable for an
-- iterator is a constant, but cannot be constant-folded.
if Ekind_In (Entity (P), E_Constant, E_Enumeration_Literal) then if Ekind (Entity (P)) = E_Enumeration_Literal
or else
(Ekind (Entity (P)) = E_Constant
and then Ekind (Scope (Entity (P))) /= E_Loop)
then
P_Entity := Etype (P); P_Entity := Etype (P);
-- The prefix denotes an enumeration type. Folding can occur -- The prefix denotes an enumeration type. Folding can occur
......
...@@ -2364,10 +2364,57 @@ package body Sem_Ch6 is ...@@ -2364,10 +2364,57 @@ package body Sem_Ch6 is
---------------------------------- ----------------------------------
procedure Build_Subprogram_Declaration is procedure Build_Subprogram_Declaration is
Asp : Node_Id; procedure Move_Pragmas (From : Node_Id; To : Node_Id);
-- Relocate certain categorization pragmas from the declarative list
-- of subprogram body From and insert them after node To. The pragmas
-- in question are:
-- Ghost
-- SPARK_Mode
-- Volatile_Function
------------------
-- Move_Pragmas --
------------------
procedure Move_Pragmas (From : Node_Id; To : Node_Id) is
Decl : Node_Id;
Next_Decl : Node_Id;
begin
pragma Assert (Nkind (From) = N_Subprogram_Body);
-- The destination node must be part of a list as the pragmas are
-- inserted after it.
pragma Assert (Is_List_Member (To));
-- Inspect the declarations of the subprogram body looking for
-- specific pragmas.
Decl := First (Declarations (N));
while Present (Decl) loop
Next_Decl := Next (Decl);
if Nkind (Decl) = N_Pragma
and then Nam_In (Pragma_Name (Decl), Name_Ghost,
Name_SPARK_Mode,
Name_Volatile_Function)
then
Remove (Decl);
Insert_After (To, Decl);
end if;
Decl := Next_Decl;
end loop;
end Move_Pragmas;
-- Local variables
Decl : Node_Id; Decl : Node_Id;
Subp_Decl : Node_Id; Subp_Decl : Node_Id;
-- Start of processing for Build_Subprogram_Declaration
begin begin
-- Create a matching subprogram spec using the profile of the body. -- Create a matching subprogram spec using the profile of the body.
-- The structure of the tree is identical, but has new entities for -- The structure of the tree is identical, but has new entities for
...@@ -2378,15 +2425,17 @@ package body Sem_Ch6 is ...@@ -2378,15 +2425,17 @@ package body Sem_Ch6 is
Specification => Copy_Subprogram_Spec (Body_Spec)); Specification => Copy_Subprogram_Spec (Body_Spec));
Set_Comes_From_Source (Subp_Decl, True); Set_Comes_From_Source (Subp_Decl, True);
-- Relocate the aspects of the subprogram body to the new subprogram -- Relocate the aspects and relevant pragmas from the subprogram body
-- spec because it acts as the initial declaration. -- to the generated spec because it acts as the initial declaration.
-- ??? what about pragmas
Insert_Before (N, Subp_Decl);
Move_Aspects (N, To => Subp_Decl); Move_Aspects (N, To => Subp_Decl);
Insert_Before_And_Analyze (N, Subp_Decl); Move_Pragmas (N, To => Subp_Decl);
Analyze (Subp_Decl);
-- The analysis of the subprogram spec aspects may introduce pragmas -- Analyze any relocated source pragmas or pragmas created for aspect
-- that need to be analyzed. -- specifications.
Decl := Next (Subp_Decl); Decl := Next (Subp_Decl);
while Present (Decl) loop while Present (Decl) loop
...@@ -2412,17 +2461,6 @@ package body Sem_Ch6 is ...@@ -2412,17 +2461,6 @@ package body Sem_Ch6 is
Set_Comes_From_Source (Spec_Id, True); Set_Comes_From_Source (Spec_Id, True);
-- If aspect SPARK_Mode was specified on the body, it needs to be
-- repeated both on the generated spec and the body.
Asp := Find_Aspect (Spec_Id, Aspect_SPARK_Mode);
if Present (Asp) then
Asp := New_Copy_Tree (Asp);
Set_Analyzed (Asp, False);
Set_Aspect_Specifications (N, New_List (Asp));
end if;
-- Ensure that the specs of the subprogram declaration and its body -- Ensure that the specs of the subprogram declaration and its body
-- are identical, otherwise they will appear non-conformant due to -- are identical, otherwise they will appear non-conformant due to
-- rewritings in the default values of formal parameters. -- rewritings in the default values of formal parameters.
...@@ -2430,6 +2468,18 @@ package body Sem_Ch6 is ...@@ -2430,6 +2468,18 @@ package body Sem_Ch6 is
Body_Spec := Copy_Subprogram_Spec (Body_Spec); Body_Spec := Copy_Subprogram_Spec (Body_Spec);
Set_Specification (N, Body_Spec); Set_Specification (N, Body_Spec);
Body_Id := Analyze_Subprogram_Specification (Body_Spec); Body_Id := Analyze_Subprogram_Specification (Body_Spec);
-- Ensure that the generated corresponding spec and original body
-- share the same Ghost and SPARK_Mode attributes.
Set_Is_Checked_Ghost_Entity
(Body_Id, Is_Checked_Ghost_Entity (Spec_Id));
Set_Is_Ignored_Ghost_Entity
(Body_Id, Is_Ignored_Ghost_Entity (Spec_Id));
Set_SPARK_Pragma (Body_Id, SPARK_Pragma (Spec_Id));
Set_SPARK_Pragma_Inherited
(Body_Id, SPARK_Pragma_Inherited (Spec_Id));
end Build_Subprogram_Declaration; end Build_Subprogram_Declaration;
---------------------------- ----------------------------
...@@ -3525,9 +3575,12 @@ package body Sem_Ch6 is ...@@ -3525,9 +3575,12 @@ package body Sem_Ch6 is
(Body_Id, SPARK_Pragma_Inherited (Prev_Id)); (Body_Id, SPARK_Pragma_Inherited (Prev_Id));
-- Set the SPARK_Mode from the current context (may be overwritten later -- Set the SPARK_Mode from the current context (may be overwritten later
-- with explicit pragma). -- with explicit pragma). Exclude the case where the SPARK_Mode appears
-- initially on a stand alone subprogram body, but is then relocated to
-- a generated corresponding spec. In this scenario the mode is shared
-- between the spec and body.
else elsif No (SPARK_Pragma (Body_Id)) then
Set_SPARK_Pragma (Body_Id, SPARK_Mode_Pragma); Set_SPARK_Pragma (Body_Id, SPARK_Mode_Pragma);
Set_SPARK_Pragma_Inherited (Body_Id); Set_SPARK_Pragma_Inherited (Body_Id);
end if; end if;
......
...@@ -7158,7 +7158,8 @@ package body Sem_Res is ...@@ -7158,7 +7158,8 @@ package body Sem_Res is
else else
-- A deferred constant that appears in an expression must have a -- A deferred constant that appears in an expression must have a
-- completion, unless it has been removed by in-place expansion of -- completion, unless it has been removed by in-place expansion of
-- an aggregate. -- an aggregate. A constant that is a renaming does not need
-- initialization.
if Ekind (E) = E_Constant if Ekind (E) = E_Constant
and then Comes_From_Source (E) and then Comes_From_Source (E)
...@@ -7166,6 +7167,7 @@ package body Sem_Res is ...@@ -7166,6 +7167,7 @@ package body Sem_Res is
and then Is_Frozen (Etype (E)) and then Is_Frozen (Etype (E))
and then not In_Spec_Expression and then not In_Spec_Expression
and then not Is_Imported (E) and then not Is_Imported (E)
and then Nkind (Parent (E)) /= N_Object_Renaming_Declaration
then then
if No_Initialization (Parent (E)) if No_Initialization (Parent (E))
or else (Present (Full_View (E)) or else (Present (Full_View (E))
......
...@@ -4950,7 +4950,10 @@ package body Sem_Util is ...@@ -4950,7 +4950,10 @@ package body Sem_Util is
-- Defining_Entity -- -- Defining_Entity --
--------------------- ---------------------
function Defining_Entity (N : Node_Id) return Entity_Id is function Defining_Entity
(N : Node_Id;
Empty_On_Errors : Boolean := False) return Entity_Id
is
Err : Entity_Id := Empty; Err : Entity_Id := Empty;
begin begin
...@@ -5028,10 +5031,14 @@ package body Sem_Util is ...@@ -5028,10 +5031,14 @@ package body Sem_Util is
-- can continue semantic analysis. -- can continue semantic analysis.
elsif Nam = Error then elsif Nam = Error then
Err := Make_Temporary (Sloc (N), 'T'); if Empty_On_Errors then
Set_Defining_Unit_Name (N, Err); return Empty;
else
Err := Make_Temporary (Sloc (N), 'T');
Set_Defining_Unit_Name (N, Err);
return Err; return Err;
end if;
-- If not an entity, get defining identifier -- If not an entity, get defining identifier
...@@ -5045,7 +5052,11 @@ package body Sem_Util is ...@@ -5045,7 +5052,11 @@ package body Sem_Util is
return Entity (Identifier (N)); return Entity (Identifier (N));
when others => when others =>
raise Program_Error; if Empty_On_Errors then
return Empty;
else
raise Program_Error;
end if;
end case; end case;
end Defining_Entity; end Defining_Entity;
......
...@@ -456,7 +456,9 @@ package Sem_Util is ...@@ -456,7 +456,9 @@ package Sem_Util is
-- in the case of a descendant of a generic formal type (returns Int'Last -- in the case of a descendant of a generic formal type (returns Int'Last
-- instead of 0). -- instead of 0).
function Defining_Entity (N : Node_Id) return Entity_Id; function Defining_Entity
(N : Node_Id;
Empty_On_Errors : Boolean := False) return Entity_Id;
-- Given a declaration N, returns the associated defining entity. If the -- Given a declaration N, returns the associated defining entity. If the
-- declaration has a specification, the entity is obtained from the -- declaration has a specification, the entity is obtained from the
-- specification. If the declaration has a defining unit name, then the -- specification. If the declaration has a defining unit name, then the
...@@ -467,6 +469,19 @@ package Sem_Util is ...@@ -467,6 +469,19 @@ package Sem_Util is
-- local entities declared during loop expansion. These entities need -- local entities declared during loop expansion. These entities need
-- debugging information, generated through Qualify_Entity_Names, and -- debugging information, generated through Qualify_Entity_Names, and
-- the loop declaration must be placed in the table Name_Qualify_Units. -- the loop declaration must be placed in the table Name_Qualify_Units.
--
-- Set flag Empty_On_Error to change the behavior of this routine as
-- follows:
--
-- * True - A declaration that lacks a defining entity returns Empty.
-- A node that does not allow for a defining entity returns Empty.
--
-- * False - A declaration that lacks a defining entity is given a new
-- internally generated entity which is subsequently returned. A node
-- that does not allow for a defining entity raises Program_Error.
--
-- The former semantic is appropriate for the backend; the latter semantic
-- is appropriate for the frontend.
function Denotes_Discriminant function Denotes_Discriminant
(N : Node_Id; (N : Node_Id;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment