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

[multiple changes]

Browse Source 
2016-06-14  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch6.adb (Set_Actual_Subtypes): Do not generate actual
	subtypes for unconstrained formals when analyzing the generated
	body of an expression function, because it may lead to premature
	and misplaced freezing of the types of formals.

2016-06-14  Gary Dismukes  <dismukes@adacore.com>

	* sem_elab.adb, sem_ch4.adb: Minor reformatting and typo fix.

2016-06-14  Tristan Gingold  <gingold@adacore.com>

	* einfo.adb (Set_Has_Timing_Event): Add assertion.
	* sem_util.ads, sem_util.adb (Propagate_Concurrent_Flags): New
	name for Propagate_Type_Has_Flags.
	* exp_ch3.adb, sem_ch3.adb, sem_ch7.adb, sem_ch9.adb: Adjust after
	renaming.

From-SVN: r237439
This commit is contained in:
Arnaud Charlet 2016-06-14 14:41:03 +02:00
parent 519e9fdfba
commit 124bed2985
11 changed files with 56 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
gcc/ada/ChangeLog
View File

@ -1,3 +1,22 @@
2016-06-14 Ed Schonberg <schonberg@adacore.com>
* sem_ch6.adb (Set_Actual_Subtypes): Do not generate actual
subtypes for unconstrained formals when analyzing the generated
body of an expression function, because it may lead to premature
and misplaced freezing of the types of formals.
2016-06-14 Gary Dismukes <dismukes@adacore.com>
* sem_elab.adb, sem_ch4.adb: Minor reformatting and typo fix.
2016-06-14 Tristan Gingold <gingold@adacore.com>
* einfo.adb (Set_Has_Timing_Event): Add assertion.
* sem_util.ads, sem_util.adb (Propagate_Concurrent_Flags): New
name for Propagate_Type_Has_Flags.
* exp_ch3.adb, sem_ch3.adb, sem_ch7.adb, sem_ch9.adb: Adjust after
renaming.
2016-06-14 Bob Duff <duff@adacore.com>
* sem_elab.adb (Check_A_Call): Do nothing if the callee is

1
gcc/ada/einfo.adb
View File

@ -4885,6 +4885,7 @@ package body Einfo is
procedure Set_Has_Timing_Event (Id : E; V : B := True) is
begin
pragma Assert (Id = Base_Type (Id));
Set_Flag289 (Id, V);
end Set_Has_Timing_Event;

4
gcc/ada/exp_ch3.adb
View File

@ -4619,7 +4619,7 @@ package body Exp_Ch3 is
-- been a private type at the point of definition. Same if component
-- type is controlled or contains protected objects.
Propagate_Type_Has_Flags (Base, Comp_Typ);
Propagate_Concurrent_Flags (Base, Comp_Typ);
Set_Has_Controlled_Component
(Base, Has_Controlled_Component (Comp_Typ)
or else Is_Controlled (Comp_Typ));
@ -5189,7 +5189,7 @@ package body Exp_Ch3 is
while Present (Comp) loop
Comp_Typ := Etype (Comp);
Propagate_Type_Has_Flags (Typ, Comp_Typ);
Propagate_Concurrent_Flags (Typ, Comp_Typ);
-- Do not set Has_Controlled_Component on a class-wide equivalent
-- type. See Make_CW_Equivalent_Type.

18
gcc/ada/sem_ch3.adb
View File

@ -4514,7 +4514,7 @@ package body Sem_Ch3 is
Set_Default_SSO (T);
Set_Etype (T, Parent_Base);
Propagate_Type_Has_Flags (T, Parent_Base);
Propagate_Concurrent_Flags (T, Parent_Base);
Set_Convention (T, Convention (Parent_Type));
Set_First_Rep_Item (T, First_Rep_Item (Parent_Type));
@ -5573,7 +5573,7 @@ package body Sem_Ch3 is
Set_First_Index (Implicit_Base, First_Index (T));
Set_Component_Type (Implicit_Base, Element_Type);
Propagate_Type_Has_Flags (Implicit_Base, Element_Type);
Propagate_Concurrent_Flags (Implicit_Base, Element_Type);
Set_Component_Size (Implicit_Base, Uint_0);
Set_Packed_Array_Impl_Type (Implicit_Base, Empty);
Set_Has_Controlled_Component (Implicit_Base,
@ -5599,7 +5599,7 @@ package body Sem_Ch3 is
Set_Is_Constrained (T, False);
Set_First_Index (T, First (Subtype_Marks (Def)));
Set_Has_Delayed_Freeze (T, True);
Propagate_Type_Has_Flags (T, Element_Type);
Propagate_Concurrent_Flags (T, Element_Type);
Set_Has_Controlled_Component (T, Has_Controlled_Component
(Element_Type)
or else
@ -8948,9 +8948,9 @@ package body Sem_Ch3 is
Set_Scope (Derived_Type, Current_Scope);
Set_Etype (Derived_Type, Parent_Base);
Set_Ekind (Derived_Type, Ekind (Parent_Base));
Propagate_Type_Has_Flags (Derived_Type, Parent_Base);
Set_Etype (Derived_Type, Parent_Base);
Set_Ekind (Derived_Type, Ekind (Parent_Base));
Propagate_Concurrent_Flags (Derived_Type, Parent_Base);
Set_Size_Info (Derived_Type, Parent_Type);
Set_RM_Size (Derived_Type, RM_Size (Parent_Type));
@ -13707,7 +13707,7 @@ package body Sem_Ch3 is
Set_Component_Size (T1, Component_Size (T2));
Set_Has_Controlled_Component (T1, Has_Controlled_Component (T2));
Set_Has_Non_Standard_Rep (T1, Has_Non_Standard_Rep (T2));
Propagate_Type_Has_Flags (T1, T2);
Propagate_Concurrent_Flags (T1, T2);
Set_Is_Packed (T1, Is_Packed (T2));
Set_Has_Aliased_Components (T1, Has_Aliased_Components (T2));
Set_Has_Atomic_Components (T1, Has_Atomic_Components (T2));
@ -19924,7 +19924,7 @@ package body Sem_Ch3 is
Set_Class_Wide_Type
(Base_Type (Full_T), Class_Wide_Type (Priv_T));
Propagate_Type_Has_Flags (Class_Wide_Type (Priv_T), Full_T);
Propagate_Concurrent_Flags (Class_Wide_Type (Priv_T), Full_T);
end if;
end;
end if;
@ -21280,7 +21280,7 @@ package body Sem_Ch3 is
Init_Component_Location (Component);
end if;
Propagate_Type_Has_Flags (T, Etype (Component));
Propagate_Concurrent_Flags (T, Etype (Component));
if Ekind (Component) /= E_Component then
null;

4
gcc/ada/sem_ch4.adb
View File

@ -3917,9 +3917,9 @@ package body Sem_Ch4 is
if Warn_On_Suspicious_Contract
and then not Referenced (Loop_Id, Cond)
then
-- Generating C this check causes spurious warnings on inlined
-- Generating C, this check causes spurious warnings on inlined
-- postconditions; we can safely disable it because this check
-- was previously performed when analying the internally built
-- was previously performed when analyzing the internally built
-- postconditions procedure.
if Modify_Tree_For_C and then In_Inlined_Body then

10
gcc/ada/sem_ch6.adb
View File

@ -11150,6 +11150,16 @@ package body Sem_Ch6 is
return;
end if;
-- The subtype declarations may freeze the formals. The body generated
-- for an expression function is not a freeze point, so do not emit
-- these declarations (small loss of efficiency in rare cases).
if Nkind (N) = N_Subprogram_Body
and then Was_Expression_Function (N)
then
return;
end if;
Formal := First_Formal (Subp);
while Present (Formal) loop
T := Etype (Formal);

2
gcc/ada/sem_ch7.adb
View File

@ -2585,7 +2585,7 @@ package body Sem_Ch7 is
Set_Finalize_Storage_Only
(Priv, Finalize_Storage_Only
(Base_Type (Full)));
Propagate_Type_Has_Flags
Propagate_Concurrent_Flags
(Priv, Base_Type (Full));
Set_Has_Controlled_Component
(Priv, Has_Controlled_Component

2
gcc/ada/sem_ch9.adb
View File

@ -1938,7 +1938,7 @@ package body Sem_Ch9 is
if Ekind_In (E, E_Function, E_Procedure) then
Set_Convention (E, Convention_Protected);
else
Propagate_Type_Has_Flags (Current_Scope, Etype (E));
Propagate_Concurrent_Flags (Current_Scope, Etype (E));
end if;
Next_Entity (E);

10
gcc/ada/sem_elab.adb
View File

@ -128,7 +128,7 @@ package body Sem_Elab is
Table_Name => "Delay_Check");
C_Scope : Entity_Id;
-- Top level scope of current scope. Compute this only once at the outer
-- Top-level scope of current scope. Compute this only once at the outer
-- level, i.e. for a call to Check_Elab_Call from outside this unit.
Outer_Level_Sloc : Source_Ptr;
@ -532,7 +532,7 @@ package body Sem_Elab is
-- Msg_S is an info message (output if Elab_Info_Messages is set.
function Find_W_Scope return Entity_Id;
-- Find top level scope for called entity (not following renamings
-- Find top-level scope for called entity (not following renamings
-- or derivations). This is where the Elaborate_All will go if it is
-- needed. We start with the called entity, except in the case of an
-- initialization procedure outside the current package, where the init
@ -653,7 +653,7 @@ package body Sem_Elab is
-- we ignore this flag.
E_Scope : Entity_Id;
-- Top level scope of entity for called subprogram. This value includes
-- Top-level scope of entity for called subprogram. This value includes
-- following renamings and derivations, so this scope can be in a
-- non-visible unit. This is the scope that is to be investigated to
-- see whether an elaboration check is required.
@ -667,7 +667,7 @@ package body Sem_Elab is
-- Flag set when a source entity is called during elaboration in SPARK
W_Scope : constant Entity_Id := Find_W_Scope;
-- Top level scope of directly called entity for subprogram. This
-- Top-level scope of directly called entity for subprogram. This
-- differs from E_Scope in the case where renamings or derivations
-- are involved, since it does not follow these links. W_Scope is
-- generally in a visible unit, and it is this scope that may require
@ -1587,7 +1587,7 @@ package body Sem_Elab is
-- Static model, call is not in elaboration code, we
-- never need to worry, because in the static model the
-- top level caller always takes care of things.
-- top-level caller always takes care of things.
else
return;

10
gcc/ada/sem_util.adb
View File

@ -18359,11 +18359,11 @@ package body Sem_Util is
Set_Sloc (Endl, Loc);
end Process_End_Label;
------------------------------
-- Propagate_Type_Has_Flags --
------------------------------
--------------------------------
-- Propagate_Concurrent_Flags --
--------------------------------
procedure Propagate_Type_Has_Flags
procedure Propagate_Concurrent_Flags
(Typ : Entity_Id;
Comp_Typ : Entity_Id) is
begin
@ -18378,7 +18378,7 @@ package body Sem_Util is
if Has_Timing_Event (Comp_Typ) then
Set_Has_Timing_Event (Typ);
end if;
end Propagate_Type_Has_Flags;
end Propagate_Concurrent_Flags;
---------------------------------------
-- Record_Possible_Part_Of_Reference --

2
gcc/ada/sem_util.ads
View File

@ -2008,7 +2008,7 @@ package Sem_Util is
-- parameter Ent gives the entity to which the End_Label refers,
-- and to which cross-references are to be generated.
procedure Propagate_Type_Has_Flags
procedure Propagate_Concurrent_Flags
(Typ : Entity_Id;
Comp_Typ : Entity_Id);
-- Set Has_Task, Has_Protected and Has_Timing_Event on Typ when the flags