From: Arnaud Charlet Date: Fri, 16 Oct 2015 12:21:03 +0000 (+0200) Subject: [multiple changes] X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=f145ece72186e2b18d2152387bd18647ed5a046d;p=gcc.git [multiple changes] 2015-10-16 Hristian Kirtchev * exp_util.adb, sem_util.ads, sem_ch6.adb, sem_ch7.adb, sem_ch8.adb: Minor reformatting. * sem_ch12.adb (Analyze_Formal_Package_Declaration): Set the SPARK_Mode from the context. 2015-10-16 Bob Duff * sem_util.adb (Requires_Transient_Scope): If Typ is a generic formal incomplete type, look at the actual type. Otherwise, we don't notice that the actual type is tagged, has a variant part, etc, causing a mismatch of calling conventions between caller and callee. 2015-10-16 Hristian Kirtchev * einfo.ads: Move the declaration of enumeration literal E_Abstract_State above E_Entry. Update the upper bound of subtype Overloadable_Kind. 2015-10-16 Gary Dismukes * exp_attr.adb: Minor editorial changes. From-SVN: r228878 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index c44a267a771..3c949fccc1f 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,28 @@ +2015-10-16 Hristian Kirtchev + + * exp_util.adb, sem_util.ads, sem_ch6.adb, sem_ch7.adb, sem_ch8.adb: + Minor reformatting. + * sem_ch12.adb (Analyze_Formal_Package_Declaration): Set the + SPARK_Mode from the context. + +2015-10-16 Bob Duff + + * sem_util.adb (Requires_Transient_Scope): + If Typ is a generic formal incomplete type, look at the actual + type. Otherwise, we don't notice that the actual type is tagged, + has a variant part, etc, causing a mismatch of calling conventions + between caller and callee. + +2015-10-16 Hristian Kirtchev + + * einfo.ads: Move the declaration of enumeration + literal E_Abstract_State above E_Entry. Update the upper bound + of subtype Overloadable_Kind. + +2015-10-16 Gary Dismukes + + * exp_attr.adb: Minor editorial changes. + 2015-10-16 Arnaud Charlet * exp_ch5.adb, sem_ch3.adb, frontend.adb, exp_ch7.adb, exp_ch7.ads, diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 9f291909431..b11814992fd 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -4819,15 +4819,15 @@ package Einfo is -- A procedure, created by a procedure declaration or a procedure -- body that acts as its own declaration. - E_Entry, - -- An entry, created by an entry declaration in a task or protected - -- object. - E_Abstract_State, -- A state abstraction. Used to designate entities introduced by aspect -- or pragma Abstract_State. The entity carries the various properties -- of the state. + E_Entry, + -- An entry, created by an entry declaration in a task or protected + -- object. + -------------------- -- Other Entities -- -------------------- @@ -5147,8 +5147,8 @@ package Einfo is -- E_Function -- E_Operator -- E_Procedure - -- E_Entry - E_Abstract_State; + -- E_Abstract_State + E_Entry; subtype Private_Kind is Entity_Kind range E_Record_Type_With_Private .. diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index ed10ccda8f1..87819271f4e 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -5783,7 +5783,7 @@ package body Exp_Attr is -- c) If the prefix is a task type, the size is obtained from the -- size variable created for each task type - -- d) If no storage_size was specified for the type, there is no + -- d) If no Storage_Size was specified for the type, there is no -- size variable, and the value is a system-specific default. else @@ -5824,7 +5824,7 @@ package body Exp_Attr is elsif Present (Storage_Size_Variable (Ptyp)) then - -- Static storage size pragma given for type: retrieve value + -- Static Storage_Size pragma given for type: retrieve value -- from its allocated storage variable. Rewrite (N, diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 3ac68ec3bc9..fb0d487ef38 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -8898,9 +8898,9 @@ package body Exp_Util is -- Remove_Side_Effects to avoid a never ending loop in the frontend. elsif not Tagged_Type_Expansion - and then not Comes_From_Source (N) - and then Nkind (Parent (N)) = N_Object_Renaming_Declaration - and then Is_Class_Wide_Type (Typ) + and then not Comes_From_Source (N) + and then Nkind (Parent (N)) = N_Object_Renaming_Declaration + and then Is_Class_Wide_Type (Typ) then return True; end if; diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index d6f53b8a0f9..94b2a392771 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -2645,6 +2645,14 @@ package body Sem_Ch12 is Set_Inner_Instances (Formal, New_Elmt_List); Push_Scope (Formal); + -- Manually set the SPARK_Mode from the context because the package + -- declaration is never analyzed. + + Set_SPARK_Pragma (Formal, SPARK_Mode_Pragma); + Set_SPARK_Aux_Pragma (Formal, SPARK_Mode_Pragma); + Set_SPARK_Pragma_Inherited (Formal); + Set_SPARK_Aux_Pragma_Inherited (Formal); + if Is_Child_Unit (Gen_Unit) and then Parent_Installed then -- Similarly, we have to make the name of the formal visible in the diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index e942477d3d1..fd5c01f0f2f 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -1296,7 +1296,7 @@ package body Sem_Ch6 is Set_Actual_Subtypes (N, Current_Scope); Set_SPARK_Pragma (Body_Id, SPARK_Mode_Pragma); - Set_SPARK_Pragma_Inherited (Body_Id, True); + Set_SPARK_Pragma_Inherited (Body_Id); -- Analyze any aspect specifications that appear on the generic -- subprogram body. @@ -3453,7 +3453,7 @@ package body Sem_Ch6 is -- Set SPARK_Mode from context Set_SPARK_Pragma (Body_Id, SPARK_Mode_Pragma); - Set_SPARK_Pragma_Inherited (Body_Id, True); + Set_SPARK_Pragma_Inherited (Body_Id); -- If the return type is an anonymous access type whose designated type -- is the limited view of a class-wide type and the non-limited view is diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb index 00efbe0ea68..70f5dfdfb79 100644 --- a/gcc/ada/sem_ch7.adb +++ b/gcc/ada/sem_ch7.adb @@ -734,12 +734,12 @@ package body Sem_Ch7 is -- Set SPARK_Mode from context Set_SPARK_Pragma (Body_Id, SPARK_Mode_Pragma); - Set_SPARK_Pragma_Inherited (Body_Id, True); + Set_SPARK_Pragma_Inherited (Body_Id); -- Set elaboration code SPARK mode the same for now Set_SPARK_Aux_Pragma (Body_Id, SPARK_Pragma (Body_Id)); - Set_SPARK_Aux_Pragma_Inherited (Body_Id, True); + Set_SPARK_Aux_Pragma_Inherited (Body_Id); end if; -- Inherit the "ghostness" of the subprogram spec. Note that this @@ -1048,8 +1048,8 @@ package body Sem_Ch7 is if Ekind (Id) = E_Package then Set_SPARK_Pragma (Id, SPARK_Mode_Pragma); Set_SPARK_Aux_Pragma (Id, SPARK_Mode_Pragma); - Set_SPARK_Pragma_Inherited (Id, True); - Set_SPARK_Aux_Pragma_Inherited (Id, True); + Set_SPARK_Pragma_Inherited (Id); + Set_SPARK_Aux_Pragma_Inherited (Id); end if; -- A package declared within a Ghost refion is automatically Ghost diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index b2c6d821d51..db697d66416 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -2776,7 +2776,7 @@ package body Sem_Ch8 is -- Set SPARK mode from current context Set_SPARK_Pragma (New_S, SPARK_Mode_Pragma); - Set_SPARK_Pragma_Inherited (New_S, True); + Set_SPARK_Pragma_Inherited (New_S); Rename_Spec := Find_Corresponding_Spec (N); diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 3295ea3d09f..b0c0591ab08 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -23,6 +23,8 @@ -- -- ------------------------------------------------------------------------------ +with Treepr; -- ???For debugging code below + with Aspects; use Aspects; with Atree; use Atree; with Casing; use Casing; @@ -16856,6 +16858,24 @@ package body Sem_Util is -- efficiency. Note: when this temporary code is removed, the documentation -- of dQ in debug.adb should be removed. + procedure Results_Differ (Id : Entity_Id); + -- ???Debugging code. Called when the Old_ and New_ results differ. Will be + -- removed when New_Requires_Transient_Scope becomes + -- Requires_Transient_Scope and Old_Requires_Transient_Scope is eliminated. + + procedure Results_Differ (Id : Entity_Id) is + begin + if False then -- False to disable; True for debugging + Treepr.Print_Tree_Node (Id); + + if Old_Requires_Transient_Scope (Id) = + New_Requires_Transient_Scope (Id) + then + raise Program_Error; + end if; + end if; + end Results_Differ; + function Requires_Transient_Scope (Id : Entity_Id) return Boolean is Old_Result : constant Boolean := Old_Requires_Transient_Scope (Id); @@ -16877,6 +16897,10 @@ package body Sem_Util is null; end if; + if New_Result /= Old_Result then + Results_Differ (Id); + end if; + return New_Result; end; end Requires_Transient_Scope; @@ -17108,7 +17132,7 @@ package body Sem_Util is begin -- This is a private type which is not completed yet. This can only -- happen in a default expression (of a formal parameter or of a - -- record component). Do not expand transient scope in this case + -- record component). Do not expand transient scope in this case. if No (Typ) then return False; @@ -17121,6 +17145,14 @@ package body Sem_Util is then return False; + -- If Typ is a generic formal incomplete type, then we want to look at + -- the actual type. + + elsif Ekind (Typ) = E_Record_Subtype + and then Present (Cloned_Subtype (Typ)) + then + return New_Requires_Transient_Scope (Cloned_Subtype (Typ)); + -- Functions returning tagged types may dispatch on result so their -- returned value is allocated on the secondary stack, even in the -- definite case. Is_Tagged_Type includes controlled types and diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index caa35401ee8..6955094b7a2 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -818,7 +818,7 @@ package Sem_Util is -- returned. Otherwise the Etype of the node is returned. function Get_Body_From_Stub (N : Node_Id) return Node_Id; - -- Return the body node for a stub. + -- Return the body node for a stub function Get_Cursor_Type (Aspect : Node_Id;