Skip to content

R
riscv-gcc-1
Commit 8d1fe980 by Arnaud Charlet
Options

[multiple changes] 

2015-05-12  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch3.adb (Add_Internal_Interface_Entities): Do no generate
	freeze nodes for these in ASIS mode, because they lead to
	elaoration order issues in gigi.

2015-05-12  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_ch6.adb (Analyze_Expression_Function): Code
	cleanup. Use Copy_Subprogram_Spec to create a proper spec.
	(Analyze_Subprogram_Body_Helper): Code cleanup. Do not
	prepare a stand alone body for inlining in GNATprove mode
	when inside a generic.	(Body_Has_Contract): Reimplemented.
	(Build_Subprogram_Declaration): New routine.
	* sem_ch10.adb (Analyze_Compilation_Unit): Capture global
	references within generic bodies by loading them.
	* sem_util.adb (Copy_Parameter_List): Code cleanup.
	(Copy_Subprogram_Spec): New routine.
	(Is_Contract_Annotation): New routine.
	* sem_util.ads (Copy_Subprogram_Spec): New routine.
	(Is_Contract_Annotation): New routine.

2015-05-12  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_attr.adb (Resolve_Attribute): Do not analyze the generated
	body of an expression function when the prefix of attribute
	'Access is the body.

From-SVN: r223048
parent cb2e1470
Showing with 183 additions and 46 deletions
gcc/ada/ChangeLog
2015-05-12 Ed Schonberg <schonberg@adacore.com>
* sem_ch3.adb (Add_Internal_Interface_Entities): Do no generate
freeze nodes for these in ASIS mode, because they lead to
elaoration order issues in gigi.
2015-05-12 Hristian Kirtchev <kirtchev@adacore.com>
* sem_ch6.adb (Analyze_Expression_Function): Code
cleanup. Use Copy_Subprogram_Spec to create a proper spec.
(Analyze_Subprogram_Body_Helper): Code cleanup. Do not
prepare a stand alone body for inlining in GNATprove mode
when inside a generic. (Body_Has_Contract): Reimplemented.
(Build_Subprogram_Declaration): New routine.
* sem_ch10.adb (Analyze_Compilation_Unit): Capture global
references within generic bodies by loading them.
* sem_util.adb (Copy_Parameter_List): Code cleanup.
(Copy_Subprogram_Spec): New routine.
(Is_Contract_Annotation): New routine.
* sem_util.ads (Copy_Subprogram_Spec): New routine.
(Is_Contract_Annotation): New routine.
2015-05-12 Hristian Kirtchev <kirtchev@adacore.com>
* sem_attr.adb (Resolve_Attribute): Do not analyze the generated
body of an expression function when the prefix of attribute
'Access is the body.
2015-05-12 Ed Schonberg <schonberg@adacore.com>
* sem_ch3.adb (Build_Derived_Enumeration_Type): The anonymous base
created for a derived enumeration type is not a first subtype,
even though it is defined through a full type declaration.
......
gcc/ada/sem_attr.adb
......@@ -10675,13 +10675,31 @@ package body Sem_Attr is
Subp_Body :=
Unit_Declaration_Node (Corresponding_Body (Subp_Decl));
-- The body has already been analyzed when the expression
-- function acts as a completion.
if Analyzed (Subp_Body) then
null;
-- Attribute 'Access may appear within the generated body
-- of the expression function subject to the attribute:
-- function F is (... F'Access ...);
-- If the expression function is on the scope stack, then
-- the body is currently being analyzed. Do not reanalyze
-- it because this will lead to infinite recursion.
elsif In_Open_Scopes (Subp_Id) then
null;
-- Analyze the body of the expression function to freeze
-- the expression. This takes care of the case where the
-- 'Access is part of dispatch table initialization and
-- the generated body of the expression function has not
-- been analyzed yet.
if not Analyzed (Subp_Body) then
else
Analyze (Subp_Body);
end if;
end if;
......
gcc/ada/sem_ch10.adb
......@@ -1020,16 +1020,18 @@ package body Sem_Ch10 is
Remove_Context (N);
-- If this is the main unit and we are generating code, we must check
-- that all generic units in the context have a body if they need it,
-- even if they have not been instantiated. In the absence of .ali files
-- for generic units, we must force the load of the body, just to
-- produce the proper error if the body is absent. We skip this
-- verification if the main unit itself is generic.
-- When generating code for a non-generic main unit, check that withed
-- generic units have a body if they need it, even if the units have not
-- been instantiated. Force the load of the bodies to produce the proper
-- error if the body is absent. The same applies to GNATprove mode, with
-- the added benefit of capturing global references within the generic.
-- This in turn allows for proper inlining of subprogram bodies without
-- a previous declaration.
if Get_Cunit_Unit_Number (N) = Main_Unit
and then Operating_Mode = Generate_Code
and then Expander_Active
and then ((Operating_Mode = Generate_Code and then Expander_Active)
or else
(Operating_Mode = Check_Semantics and then GNATprove_Mode))
then
-- Check whether the source for the body of the unit must be included
-- in a standalone library.
......@@ -1066,7 +1068,7 @@ package body Sem_Ch10 is
then
Nam := Entity (Name (Item));
-- Compile generic subprogram, unless it is intrinsic or
-- Compile the generic subprogram, unless it is intrinsic or
-- imported so no body is required, or generic package body
-- if the package spec requires a body.
......@@ -1081,7 +1083,8 @@ package body Sem_Ch10 is
if Present (Renamed_Object (Nam)) then
Un :=
Load_Unit
(Load_Name => Get_Body_Name
(Load_Name =>
Get_Body_Name
(Get_Unit_Name
(Unit_Declaration_Node
(Renamed_Object (Nam)))),
......@@ -1092,8 +1095,8 @@ package body Sem_Ch10 is
else
Un :=
Load_Unit
(Load_Name => Get_Body_Name
(Get_Unit_Name (Item)),
(Load_Name =>
Get_Body_Name (Get_Unit_Name (Item)),
Required => False,
Subunit => False,
Error_Node => N,
......
gcc/ada/sem_ch3.adb
......@@ -1772,10 +1772,14 @@ package body Sem_Ch3 is
-- locally defined tagged types (or compiling with static
-- dispatch tables generation disabled) the corresponding
-- entry of the secondary dispatch table is filled when
-- such an entity is frozen.
-- such an entity is frozen. This is an expansion activity
-- that must be suppressed for ASIS because it leads to
-- gigi elaboration issues in annotate mode.
if not ASIS_Mode then
Set_Has_Delayed_Freeze (New_Subp);
end if;
end if;
<<Continue>>
Next_Elmt (Elmt);
......@@ -1794,7 +1798,7 @@ package body Sem_Ch3 is
-----------------------------------
procedure Analyze_Component_Declaration (N : Node_Id) is
Loc : constant Source_Ptr := Sloc (N);
Loc : constant Source_Ptr := Sloc (Component_Definition (N));
Id : constant Entity_Id := Defining_Identifier (N);
E : constant Node_Id := Expression (N);
Typ : constant Node_Id :=
......@@ -2137,9 +2141,14 @@ package body Sem_Ch3 is
then
declare
Act_T : constant Entity_Id := Build_Default_Subtype (T, N);
begin
Set_Etype (Id, Act_T);
Set_Component_Definition (N,
-- Rewrite the component definition to use the constrained
-- subtype.
Rewrite (Component_Definition (N),
Make_Component_Definition (Loc,
Subtype_Indication => New_Occurrence_Of (Act_T, Loc)));
end;
......
gcc/ada/sem_util.adb
......@@ -4415,18 +4415,16 @@ package body Sem_Util is
Plist := New_List;
Formal := First_Formal (Subp_Id);
while Present (Formal) loop
Append
(Make_Parameter_Specification (Loc,
Append_To (Plist,
Make_Parameter_Specification (Loc,
Defining_Identifier =>
Make_Defining_Identifier (Sloc (Formal),
Chars => Chars (Formal)),
Make_Defining_Identifier (Sloc (Formal), Chars (Formal)),
In_Present => In_Present (Parent (Formal)),
Out_Present => Out_Present (Parent (Formal)),
Parameter_Type =>
New_Occurrence_Of (Etype (Formal), Loc),
Expression =>
New_Copy_Tree (Expression (Parent (Formal)))),
Plist);
New_Copy_Tree (Expression (Parent (Formal)))));
Next_Formal (Formal);
end loop;
......@@ -4435,6 +4433,43 @@ package body Sem_Util is
return Plist;
end Copy_Parameter_List;
--------------------------
-- Copy_Subprogram_Spec --
--------------------------
function Copy_Subprogram_Spec (Spec : Node_Id) return Node_Id is
Def_Id : Node_Id;
Formal_Spec : Node_Id;
Result : Node_Id;
begin
-- The structure of the original tree must be replicated without any
-- alterations. Use New_Copy_Tree for this purpose.
Result := New_Copy_Tree (Spec);
-- Create a new entity for the defining unit name
Def_Id := Defining_Unit_Name (Result);
Set_Defining_Unit_Name (Result,
Make_Defining_Identifier (Sloc (Def_Id), Chars (Def_Id)));
-- Create new entities for the formal parameters
if Present (Parameter_Specifications (Result)) then
Formal_Spec := First (Parameter_Specifications (Result));
while Present (Formal_Spec) loop
Def_Id := Defining_Identifier (Formal_Spec);
Set_Defining_Identifier (Formal_Spec,
Make_Defining_Identifier (Sloc (Def_Id), Chars (Def_Id)));
Next (Formal_Spec);
end loop;
end if;
return Result;
end Copy_Subprogram_Spec;
--------------------------------
-- Corresponding_Generic_Type --
--------------------------------
......@@ -10299,6 +10334,29 @@ package body Sem_Util is
or else Is_Task_Interface (T));
end Is_Concurrent_Interface;
-----------------------
-- Is_Constant_Bound --
-----------------------
function Is_Constant_Bound (Exp : Node_Id) return Boolean is
begin
if Compile_Time_Known_Value (Exp) then
return True;
elsif Is_Entity_Name (Exp) and then Present (Entity (Exp)) then
return Is_Constant_Object (Entity (Exp))
or else Ekind (Entity (Exp)) = E_Enumeration_Literal;
elsif Nkind (Exp) in N_Binary_Op then
return Is_Constant_Bound (Left_Opnd (Exp))
and then Is_Constant_Bound (Right_Opnd (Exp))
and then Scope (Entity (Exp)) = Standard_Standard;
else
return False;
end if;
end Is_Constant_Bound;
---------------------------
-- Is_Container_Element --
---------------------------
......@@ -10478,28 +10536,40 @@ package body Sem_Util is
end;
end Is_Container_Element;
-----------------------
-- Is_Constant_Bound --
-----------------------
function Is_Constant_Bound (Exp : Node_Id) return Boolean is
begin
if Compile_Time_Known_Value (Exp) then
return True;
----------------------------
-- Is_Contract_Annotation --
----------------------------
elsif Is_Entity_Name (Exp) and then Present (Entity (Exp)) then
return Is_Constant_Object (Entity (Exp))
or else Ekind (Entity (Exp)) = E_Enumeration_Literal;
function Is_Contract_Annotation (Item : Node_Id) return Boolean is
Nam : Name_Id;
elsif Nkind (Exp) in N_Binary_Op then
return Is_Constant_Bound (Left_Opnd (Exp))
and then Is_Constant_Bound (Right_Opnd (Exp))
and then Scope (Entity (Exp)) = Standard_Standard;
begin
if Nkind (Item) = N_Aspect_Specification then
Nam := Chars (Identifier (Item));
else
return False;
else pragma Assert (Nkind (Item) = N_Pragma);
Nam := Pragma_Name (Item);
end if;
end Is_Constant_Bound;
return
Nam = Name_Abstract_State
or else Nam = Name_Contract_Cases
or else Nam = Name_Depends
or else Nam = Name_Extensions_Visible
or else Nam = Name_Global
or else Nam = Name_Initial_Condition
or else Nam = Name_Initializes
or else Nam = Name_Post
or else Nam = Name_Post_Class
or else Nam = Name_Postcondition
or else Nam = Name_Pre
or else Nam = Name_Pre_Class
or else Nam = Name_Precondition
or else Nam = Name_Refined_Depends
or else Nam = Name_Refined_Global
or else Nam = Name_Refined_State
or else Nam = Name_Test_Case;
end Is_Contract_Annotation;
--------------------------------------
-- Is_Controlling_Limited_Procedure --
......
gcc/ada/sem_util.ads
......@@ -397,12 +397,6 @@ package Sem_Util is
-- Depends
-- Global
function Copy_Parameter_List (Subp_Id : Entity_Id) return List_Id;
-- Utility to create a parameter profile for a new subprogram spec, when
-- the subprogram has a body that acts as spec. This is done for some cases
-- of inlining, and for private protected ops. Also used to create bodies
-- for stubbed subprograms.
function Copy_Component_List
(R_Typ : Entity_Id;
Loc : Source_Ptr) return List_Id;
......@@ -410,6 +404,17 @@ package Sem_Util is
-- create a new compatible record type. Loc is the source location assigned
-- to the created nodes.
function Copy_Parameter_List (Subp_Id : Entity_Id) return List_Id;
-- Utility to create a parameter profile for a new subprogram spec, when
-- the subprogram has a body that acts as spec. This is done for some cases
-- of inlining, and for private protected ops. Also used to create bodies
-- for stubbed subprograms.
function Copy_Subprogram_Spec (Spec : Node_Id) return Node_Id;
-- Replicate a function or a procedure specification denoted by Spec. The
-- resulting tree is an exact duplicate of the original tree. New entities
-- are created for the unit name and the formal parameters.
function Corresponding_Generic_Type (T : Entity_Id) return Entity_Id;
-- If a type is a generic actual type, return the corresponding formal in
-- the generic parent unit. There is no direct link in the tree for this
......@@ -1186,6 +1191,10 @@ package Sem_Util is
-- explicit dereference. The transformation applies when it has the form
-- F (X).Discr.all.
function Is_Contract_Annotation (Item : Node_Id) return Boolean;
-- Determine whether aspect specification or pragma Item is a contract
-- annotation.
function Is_Controlling_Limited_Procedure
(Proc_Nam : Entity_Id) return Boolean;
-- Ada 2005 (AI-345): Determine whether Proc_Nam is a primitive procedure
......
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