+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>
* inline.adb (Is_Expression_Function): Removed.
Make_Integer_Literal (Loc, Enumeration_Rep (Entity (Pref))));
-- 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
and then Present (Renamed_Object (Entity (Pref)))
+ and then Is_Entity_Name (Renamed_Object (Entity (Pref)))
and then Ekind (Entity (Renamed_Object (Entity (Pref)))) =
E_Enumeration_Literal
then
-- been compiled.
if Opt.CodePeer_Mode then
+ if Tname_FD /= Invalid_FD then
+ Delete (Tname);
+ end if;
+
return;
end if;
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 one was created. See Process_Bind_File for details.
-
- if Tname_FD /= Invalid_FD then
- 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);
Exit_Program (E_Fatal);
end if;
if Is_Entity_Name (P) then
-- 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);
-- The prefix denotes an enumeration type. Folding can occur
----------------------------------
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;
Subp_Decl : Node_Id;
+ -- Start of processing for Build_Subprogram_Declaration
+
begin
-- Create a matching subprogram spec using the profile of the body.
-- The structure of the tree is identical, but has new entities for
Specification => Copy_Subprogram_Spec (Body_Spec));
Set_Comes_From_Source (Subp_Decl, True);
- -- Relocate the aspects of the subprogram body to the new subprogram
- -- spec because it acts as the initial declaration.
- -- ??? what about pragmas
+ -- Relocate the aspects and relevant pragmas from the subprogram body
+ -- to the generated spec because it acts as the initial declaration.
+ Insert_Before (N, 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
- -- that need to be analyzed.
+ -- Analyze any relocated source pragmas or pragmas created for aspect
+ -- specifications.
Decl := Next (Subp_Decl);
while Present (Decl) loop
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
-- are identical, otherwise they will appear non-conformant due to
-- rewritings in the default values of formal parameters.
Body_Spec := Copy_Subprogram_Spec (Body_Spec);
Set_Specification (N, 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;
----------------------------
(Body_Id, SPARK_Pragma_Inherited (Prev_Id));
-- 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_Inherited (Body_Id);
end if;
else
-- A deferred constant that appears in an expression must have a
-- 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
and then Comes_From_Source (E)
and then Is_Frozen (Etype (E))
and then not In_Spec_Expression
and then not Is_Imported (E)
+ and then Nkind (Parent (E)) /= N_Object_Renaming_Declaration
then
if No_Initialization (Parent (E))
or else (Present (Full_View (E))
-- 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;
begin
-- can continue semantic analysis.
elsif Nam = Error then
- Err := Make_Temporary (Sloc (N), 'T');
- Set_Defining_Unit_Name (N, Err);
+ if Empty_On_Errors then
+ 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
return Entity (Identifier (N));
when others =>
- raise Program_Error;
+ if Empty_On_Errors then
+ return Empty;
+ else
+ raise Program_Error;
+ end if;
end case;
end Defining_Entity;
-- in the case of a descendant of a generic formal type (returns Int'Last
-- 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
-- declaration has a specification, the entity is obtained from the
-- specification. If the declaration has a defining unit name, then the
-- local entities declared during loop expansion. These entities need
-- debugging information, generated through Qualify_Entity_Names, and
-- 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
(N : Node_Id;
projects / gcc.git / commitdiff