From c70cf4f8eb5bf8623e0f89eef6aabf308ef04c1b Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 4 Jul 2016 12:41:23 +0200 Subject: [PATCH] [multiple changes] 2016-07-04 Hristian Kirtchev * freeze.adb, ghost.adb, sem_ch13.adb: Minor reformatting. 2016-07-04 Pascal Obry * g-forstr.ads: More documentation for the Formatted_String support. 2016-07-04 Justin Squirek * sem_ch7.adb (Install_Parent_Private_Declarations): When instantiating a child unit, do not install private declaration of a non-generic ancestor of the generic that is also an ancestor of the current unit: its private part will be installed when private part of ancestor itself is analyzed. 2016-07-04 Ed Schonberg * sem_ch12.adb (Instantiate_Object): In SPARK mode add a guard to verify that the actual is an object reference before checking for volatility. (Check_Generic_Child_Unit): Prevent cascaded errors when prefix is illegal. From-SVN: r237969 --- gcc/ada/ChangeLog | 25 +++++++++++++++++++ gcc/ada/freeze.adb | 59 +++++++++++++++++++++++--------------------- gcc/ada/g-forstr.ads | 7 +++++- gcc/ada/ghost.adb | 2 ++ gcc/ada/sem_ch12.adb | 25 ++++++++++++------- gcc/ada/sem_ch13.adb | 3 +-- gcc/ada/sem_ch7.adb | 21 +++++++++++----- 7 files changed, 96 insertions(+), 46 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 680902f1f82..c0f7ff767f6 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,28 @@ +2016-07-04 Hristian Kirtchev + + * freeze.adb, ghost.adb, sem_ch13.adb: Minor reformatting. + +2016-07-04 Pascal Obry + + * g-forstr.ads: More documentation for the Formatted_String + support. + +2016-07-04 Justin Squirek + + * sem_ch7.adb (Install_Parent_Private_Declarations): When + instantiating a child unit, do not install private declaration of + a non-generic ancestor of the generic that is also an ancestor + of the current unit: its private part will be installed when + private part of ancestor itself is analyzed. + +2016-07-04 Ed Schonberg + + * sem_ch12.adb (Instantiate_Object): In SPARK mode add a guard + to verify that the actual is an object reference before checking + for volatility. + (Check_Generic_Child_Unit): Prevent cascaded errors when prefix + is illegal. + 2016-07-04 Gary Dismukes * sem_ch12.ads, freeze.adb: Minor reformatting and typo fixes. diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index cfb20f4f495..3d6dd18e2ab 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -3561,32 +3561,11 @@ package body Freeze is Junk : Boolean; pragma Warnings (Off, Junk); - Rec_Pushed : Boolean := False; - -- Set True if the record type scope Rec has been pushed on the scope - -- stack. Needed for the analysis of delayed aspects specified to the - -- components of Rec. - - SSO_ADC : Node_Id; - -- Scalar_Storage_Order attribute definition clause for the record - - Unplaced_Component : Boolean := False; - -- Set True if we find at least one component with no component - -- clause (used to warn about useless Pack pragmas). - - Placed_Component : Boolean := False; - -- Set True if we find at least one component with a component - -- clause (used to warn about useless Bit_Order pragmas, and also - -- to detect cases where Implicit_Packing may have an effect). - Aliased_Component : Boolean := False; -- Set True if we find at least one component which is aliased. This -- is used to prevent Implicit_Packing of the record, since packing -- cannot modify the size of alignment of an aliased component. - SSO_ADC_Component : Boolean := False; - -- Set True if we find at least one component whose type has a - -- Scalar_Storage_Order attribute definition clause. - All_Elem_Components : Boolean := True; -- Set False if we encounter a component of a composite type @@ -3601,10 +3580,31 @@ package body Freeze is -- Accumulates total Esize values of all elementary components. Used -- for processing of Implicit_Packing. + Placed_Component : Boolean := False; + -- Set True if we find at least one component with a component + -- clause (used to warn about useless Bit_Order pragmas, and also + -- to detect cases where Implicit_Packing may have an effect). + + Rec_Pushed : Boolean := False; + -- Set True if the record type scope Rec has been pushed on the scope + -- stack. Needed for the analysis of delayed aspects specified to the + -- components of Rec. + Sized_Component_Total_RM_Size : Uint := Uint_0; -- Accumulates total RM_Size values of all sized components. Used -- for processing of Implicit_Packing. + SSO_ADC : Node_Id; + -- Scalar_Storage_Order attribute definition clause for the record + + SSO_ADC_Component : Boolean := False; + -- Set True if we find at least one component whose type has a + -- Scalar_Storage_Order attribute definition clause. + + Unplaced_Component : Boolean := False; + -- Set True if we find at least one component with no component + -- clause (used to warn about useless Pack pragmas). + function Check_Allocator (N : Node_Id) return Node_Id; -- If N is an allocator, possibly wrapped in one or more level of -- qualified expression(s), return the inner allocator node, else @@ -4419,10 +4419,12 @@ package body Freeze is -- packing is required for it, as we are sure in this case that -- the back end cannot do the expected layout without packing. - and then ((All_Elem_Components - and then RM_Size (Rec) < Elem_Component_Total_Esize) - or else (not All_Elem_Components - and then not All_Storage_Unit_Components)) + and then + ((All_Elem_Components + and then RM_Size (Rec) < Elem_Component_Total_Esize) + or else + (not All_Elem_Components + and then not All_Storage_Unit_Components)) -- And the total RM size cannot be greater than the specified size -- since otherwise packing will not get us where we have to be. @@ -5461,20 +5463,21 @@ package body Freeze is -- the RM_Size of the component type. if RM_Size (E) = Num_Elmts * Rsiz then + -- For implicit packing mode, just set the component -- size and Freeze_Array_Type will do the rest. if Implicit_Packing then Set_Component_Size (Btyp, Rsiz); - -- Otherwise give an error message + -- Otherwise give an error message else Error_Msg_NE ("size given for& too small", SZ, E); Error_Msg_N -- CODEFIX - ("\use explicit pragma Pack " - & "or use pragma Implicit_Packing", SZ); + ("\use explicit pragma Pack or use pragma " + & "Implicit_Packing", SZ); end if; end if; end if; diff --git a/gcc/ada/g-forstr.ads b/gcc/ada/g-forstr.ads index a43ba5f7a84..88856a35b3a 100644 --- a/gcc/ada/g-forstr.ads +++ b/gcc/ada/g-forstr.ads @@ -144,7 +144,12 @@ package GNAT.Formatted_String is use Ada; type Formatted_String (<>) is private; - -- A format string as defined for printf routine + -- A format string as defined for printf routine. This string is the + -- actual format for all the parameters added with the "&" routines below. + -- Note that a Formatted_String object can't be reused as it serves as + -- recipient for the final result. That is, each use of "&" will build + -- incrementally the final result string which can be retrieved with + -- the "-" routine below. Format_Error : exception; -- Raised for every mismatch between the parameter and the expected format diff --git a/gcc/ada/ghost.adb b/gcc/ada/ghost.adb index 8add17ae1ee..3d3d67c995c 100644 --- a/gcc/ada/ghost.adb +++ b/gcc/ada/ghost.adb @@ -1177,6 +1177,8 @@ package body Ghost is -- A freeze node for an ignored ghost entity must be pruned as -- well, to prevent meaningless references in the back end. + -- ??? the freeze node itself should be ignored ghost + elsif Nkind (N) = N_Freeze_Entity and then Is_Ignored_Ghost_Entity (Entity (N)) then diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 1b4807746e4..3648146445a 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -6695,17 +6695,23 @@ package body Sem_Ch12 is elsif Nkind (Gen_Id) = N_Expanded_Name then - -- Entity already present, analyze prefix, whose meaning may be - -- an instance in the current context. If it is an instance of - -- a relative within another, the proper parent may still have - -- to be installed, if they are not of the same generation. + -- Entity already present, analyze prefix, whose meaning may be an + -- instance in the current context. If it is an instance of a + -- relative within another, the proper parent may still have to be + -- installed, if they are not of the same generation. Analyze (Prefix (Gen_Id)); - -- In the unlikely case that a local declaration hides the name - -- of the parent package, locate it on the homonym chain. If the - -- context is an instance of the parent, the renaming entity is - -- flagged as such. + -- Prevent cascaded errors + + if Etype (Prefix (Gen_Id)) = Any_Type then + return; + end if; + + -- In the unlikely case that a local declaration hides the name of + -- the parent package, locate it on the homonym chain. If the context + -- is an instance of the parent, the renaming entity is flagged as + -- such. Inst_Par := Entity (Prefix (Gen_Id)); while Present (Inst_Par) @@ -10681,10 +10687,11 @@ package body Sem_Ch12 is -- An effectively volatile object cannot be used as an actual in a -- generic instantiation (SPARK RM 7.1.3(7)). The following check is -- relevant only when SPARK_Mode is on as it is not a standard Ada - -- legality rule. + -- legality rule, and also verifies that the actual is an object. if SPARK_Mode = On and then Present (Actual) + and then Is_Object_Reference (Actual) and then Is_Effectively_Volatile_Object (Actual) then Error_Msg_N diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index aaa8576ee26..163f8d68d11 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -12049,7 +12049,7 @@ package body Sem_Ch13 is Subp_Decl := Make_Subprogram_Renaming_Declaration (Loc, Specification => Build_Spec, - Name => New_Occurrence_Of (Subp, Loc)); + Name => New_Occurrence_Of (Subp, Loc)); if Defer_Declaration then Set_TSS (Base_Type (Ent), Subp_Id); @@ -12057,7 +12057,6 @@ package body Sem_Ch13 is else if From_Aspect_Specification (N) then Append_Freeze_Action (Ent, Subp_Decl); - else Insert_Action (N, Subp_Decl); end if; diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb index 01a5edbbc3a..eeb7a75612f 100644 --- a/gcc/ada/sem_ch7.adb +++ b/gcc/ada/sem_ch7.adb @@ -1392,7 +1392,7 @@ package body Sem_Ch7 is -- If one of the non-generic parents is itself on the scope -- stack, do not install its private declarations: they are -- installed in due time when the private part of that parent - -- is analyzed. This is delicate ??? + -- is analyzed. else while Present (Inst_Par) @@ -1400,11 +1400,20 @@ package body Sem_Ch7 is and then (not In_Open_Scopes (Inst_Par) or else not In_Private_Part (Inst_Par)) loop - Install_Private_Declarations (Inst_Par); - Set_Use (Private_Declarations - (Specification - (Unit_Declaration_Node (Inst_Par)))); - Inst_Par := Scope (Inst_Par); + if Nkind (Inst_Node) = N_Formal_Package_Declaration + or else + not Is_Ancestor_Package + (Inst_Par, Cunit_Entity (Current_Sem_Unit)) + then + Install_Private_Declarations (Inst_Par); + Set_Use + (Private_Declarations + (Specification + (Unit_Declaration_Node (Inst_Par)))); + Inst_Par := Scope (Inst_Par); + else + exit; + end if; end loop; exit; -- 2.30.2