diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 37 | ||||
| -rw-r--r-- | gcc/ada/exp_aggr.adb | 45 | ||||
| -rw-r--r-- | gcc/ada/exp_ch3.adb | 18 | ||||
| -rw-r--r-- | gcc/ada/exp_ch3.ads | 8 | ||||
| -rw-r--r-- | gcc/ada/exp_prag.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/exp_util.adb | 31 | ||||
| -rw-r--r-- | gcc/ada/exp_util.ads | 5 | ||||
| -rw-r--r-- | gcc/ada/freeze.adb | 8 | ||||
| -rw-r--r-- | gcc/ada/opt.ads | 4 | ||||
| -rw-r--r-- | gcc/ada/sem.adb | 1 | ||||
| -rw-r--r-- | gcc/ada/sem_ch6.adb | 5 | ||||
| -rw-r--r-- | gcc/ada/sem_ch7.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/sem_elab.adb | 2 |
13 files changed, 119 insertions, 51 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 85fd581b687..3b5d5f6fd4b 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,42 @@ 2010-06-14 Robert Dewar <dewar@adacore.com> + * opt.ads, sem.adb, sem_elab.adb: Minor reformatting + +2010-06-14 Robert Dewar <dewar@adacore.com> + + * exp_aggr.adb (Has_Address_Clause): Moved to Exp_Util, and there it + is renamed as Has_Following_Address_Clause. + * exp_ch3.adb (Needs_Simple_Initialization): Add Consider_IS argument + to allow the caller to avoid Initialize_Scalars having an effect. + (Expand_N_Object_Declaration): Do not do Initialize_Scalars stuff for + scalars with an address clause specified. + * exp_ch3.ads (Needs_Simple_Initialization): Add Consider_IS argument + to allow the caller to avoid Initialize_Scalars having an effect. + * exp_util.adb (Has_Following_Address_Clause): Moved here from Exp_Aggr + (where it was called Has_Address_Clause). + * exp_util.ads (Has_Following_Address_Clause): Moved here from Exp_Aggr + (where it was called Has_Address_Clause). + * freeze.adb (Warn_Overlay): Suppress message about overlaying causing + problems for Initialize_Scalars (since we no longer initialize objects + with an address clause. + +2010-06-14 Robert Dewar <dewar@adacore.com> + + * exp_prag.adb (Expand_Pragma_Check): Set Loc of generated code from + condition. + +2010-06-14 Gary Dismukes <dismukes@adacore.com> + + * sem_ch6.adb (Analyze_Subprogram_Body_Helper): Set Debug_Info_Needed + on the entity of an implicitly generated postcondition procedure. + +2010-06-14 Thomas Quinot <quinot@adacore.com> + + * sem_ch7.adb (Preserve_Full_Attributes): Propagate + Discriminant_Constraint elist from full view to private view. + +2010-06-14 Robert Dewar <dewar@adacore.com> + * sem_res.adb: Minor reformatting 2010-06-14 Ed Schonberg <schonberg@adacore.com> diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 6e3edc192b9..dc6c8bb90d0 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -4122,12 +4122,6 @@ package body Exp_Aggr is -- array sub-aggregate we start the computation from. Dim is the -- dimension corresponding to the sub-aggregate. - function Has_Address_Clause (D : Node_Id) return Boolean; - -- If the aggregate is the expression in an object declaration, it - -- cannot be expanded in place. This function does a lookahead in the - -- current declarative part to find an address clause for the object - -- being declared. - function In_Place_Assign_OK return Boolean; -- Simple predicate to determine whether an aggregate assignment can -- be done in place, because none of the new values can depend on the @@ -4435,35 +4429,6 @@ package body Exp_Aggr is end Compute_Others_Present; ------------------------ - -- Has_Address_Clause -- - ------------------------ - - function Has_Address_Clause (D : Node_Id) return Boolean is - Id : constant Entity_Id := Defining_Identifier (D); - Decl : Node_Id; - - begin - Decl := Next (D); - while Present (Decl) loop - if Nkind (Decl) = N_At_Clause - and then Chars (Identifier (Decl)) = Chars (Id) - then - return True; - - elsif Nkind (Decl) = N_Attribute_Definition_Clause - and then Chars (Decl) = Name_Address - and then Chars (Name (Decl)) = Chars (Id) - then - return True; - end if; - - Next (Decl); - end loop; - - return False; - end Has_Address_Clause; - - ------------------------ -- In_Place_Assign_OK -- ------------------------ @@ -5162,6 +5127,8 @@ package body Exp_Aggr is Build_Activation_Chain_Entity (N); end if; + -- Should document these individual tests ??? + if not Has_Default_Init_Comps (N) and then Comes_From_Source (Parent (N)) and then Nkind (Parent (N)) = N_Object_Declaration @@ -5170,7 +5137,13 @@ package body Exp_Aggr is and then N = Expression (Parent (N)) and then not Is_Bit_Packed_Array (Typ) and then not Has_Controlled_Component (Typ) - and then not Has_Address_Clause (Parent (N)) + + -- If the aggregate is the expression in an object declaration, it + -- cannot be expanded in place. Lookahead in the current declarative + -- part to find an address clause for the object being declared. If + -- one is present, we cannot build in place. Unclear comment??? + + and then not Has_Following_Address_Clause (Parent (N)) then Tmp := Defining_Identifier (Parent (N)); Set_No_Initialization (Parent (N)); diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 83fc7e39d41..e36c8dcf24f 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -4466,7 +4466,10 @@ package body Exp_Ch3 is -- it will be assigned subsequently. In particular, there is no point -- in applying Initialize_Scalars to such a temporary. - elsif Needs_Simple_Initialization (Typ) + elsif Needs_Simple_Initialization + (Typ, + Initialize_Scalars + and then not Has_Following_Address_Clause (N)) and then not Is_Internal (Def_Id) and then not Has_Init_Expression (N) then @@ -8145,7 +8148,14 @@ package body Exp_Ch3 is -- Needs_Simple_Initialization -- --------------------------------- - function Needs_Simple_Initialization (T : Entity_Id) return Boolean is + function Needs_Simple_Initialization + (T : Entity_Id; + Consider_IS : Boolean := True) return Boolean + is + Consider_IS_NS : constant Boolean := + Normalize_Scalars + or (Initialize_Scalars and Consider_IS); + begin -- Check for private type, in which case test applies to the underlying -- type of the private type. @@ -8167,7 +8177,7 @@ package body Exp_Ch3 is -- types. elsif Is_Access_Type (T) - or else (Init_Or_Norm_Scalars and then (Is_Scalar_Type (T))) + or else (Consider_IS_NS and then (Is_Scalar_Type (T))) then return True; @@ -8176,7 +8186,7 @@ package body Exp_Ch3 is -- expanding an aggregate (since in the latter case they will be -- filled with appropriate initializing values before they are used). - elsif Init_Or_Norm_Scalars + elsif Consider_IS_NS and then (Root_Type (T) = Standard_String or else Root_Type (T) = Standard_Wide_String diff --git a/gcc/ada/exp_ch3.ads b/gcc/ada/exp_ch3.ads index 6738ae958f9..9b838b0b652 100644 --- a/gcc/ada/exp_ch3.ads +++ b/gcc/ada/exp_ch3.ads @@ -126,14 +126,18 @@ package Exp_Ch3 is -- then tags components located at variable positions of Target are -- initialized. - function Needs_Simple_Initialization (T : Entity_Id) return Boolean; + function Needs_Simple_Initialization + (T : Entity_Id; + Consider_IS : Boolean := True) return Boolean; -- Certain types need initialization even though there is no specific -- initialization routine. In this category are access types (which need -- initializing to null), packed array types whose implementation is a -- modular type, and all scalar types if Normalize_Scalars is set, as well -- as private types whose underlying type is present and meets any of these -- criteria. Finally, descendants of String and Wide_String also need - -- initialization in Initialize/Normalize_Scalars mode. + -- initialization in Initialize/Normalize_Scalars mode. Consider_IS is + -- normally True. If it is False, the Initialize_Scalars is not considered + -- in determining whether simple initialization is needed. function Get_Simple_Init_Val (T : Entity_Id; diff --git a/gcc/ada/exp_prag.adb b/gcc/ada/exp_prag.adb index 6bddf9670b9..7ff2f77eedb 100644 --- a/gcc/ada/exp_prag.adb +++ b/gcc/ada/exp_prag.adb @@ -269,8 +269,8 @@ package body Exp_Prag is -------------------------- procedure Expand_Pragma_Check (N : Node_Id) is - Loc : constant Source_Ptr := Sloc (N); Cond : constant Node_Id := Arg2 (N); + Loc : constant Source_Ptr := Sloc (Cond); Nam : constant Name_Id := Chars (Arg1 (N)); Msg : Node_Id; diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index c450b677faf..1fc19daaefe 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -2143,6 +2143,37 @@ package body Exp_Util is return False; end Has_Controlled_Coextensions; + ------------------------ + -- Has_Address_Clause -- + ------------------------ + + -- Should this function check the private part in a package ??? + + function Has_Following_Address_Clause (D : Node_Id) return Boolean is + Id : constant Entity_Id := Defining_Identifier (D); + Decl : Node_Id; + + begin + Decl := Next (D); + while Present (Decl) loop + if Nkind (Decl) = N_At_Clause + and then Chars (Identifier (Decl)) = Chars (Id) + then + return True; + + elsif Nkind (Decl) = N_Attribute_Definition_Clause + and then Chars (Decl) = Name_Address + and then Chars (Name (Decl)) = Chars (Id) + then + return True; + end if; + + Next (Decl); + end loop; + + return False; + end Has_Following_Address_Clause; + -------------------- -- Homonym_Number -- -------------------- diff --git a/gcc/ada/exp_util.ads b/gcc/ada/exp_util.ads index 1f3c9e8a211..b036338da97 100644 --- a/gcc/ada/exp_util.ads +++ b/gcc/ada/exp_util.ads @@ -444,6 +444,11 @@ package Exp_Util is -- Determine whether a record type has anonymous access discriminants with -- a controlled designated type. + function Has_Following_Address_Clause (D : Node_Id) return Boolean; + -- D is the node for an object declaration. This function searches the + -- current declarative part to look for an address clause for the object + -- being declared, and returns True if one is found. + function Homonym_Number (Subp : Entity_Id) return Nat; -- Here subp is the entity for a subprogram. This routine returns the -- homonym number used to disambiguate overloaded subprograms in the same diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index c9639361ec0..e29904f158f 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -5659,16 +5659,18 @@ package body Freeze is -- We only give the warning for non-imported entities of a type for -- which a non-null base init proc is defined, or for objects of access - -- types with implicit null initialization, or when Initialize_Scalars + -- types with implicit null initialization, or when Normalize_Scalars -- applies and the type is scalar or a string type (the latter being -- tested for because predefined String types are initialized by inline - -- code rather than by an init_proc). + -- code rather than by an init_proc). Note that we do not give the + -- warning for Initialize_Scalars, since we suppressed initialization + -- in this case. if Present (Expr) and then not Is_Imported (Ent) and then (Has_Non_Null_Base_Init_Proc (Typ) or else Is_Access_Type (Typ) - or else (Init_Or_Norm_Scalars + or else (Normalize_Scalars and then (Is_Scalar_Type (Typ) or else Is_String_Type (Typ)))) then diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads index 9013d7d3dcd..4581116670c 100644 --- a/gcc/ada/opt.ads +++ b/gcc/ada/opt.ads @@ -183,8 +183,8 @@ package Opt is Bind_For_Library : Boolean := False; -- GNATBIND - -- Set to True if the binder needs to generate a file designed for - -- building a library. May be set to True by Gnatbind.Scan_Bind_Arg. + -- Set to True if the binder needs to generate a file designed for building + -- a library. May be set to True by Gnatbind.Scan_Bind_Arg. Bind_Only : Boolean := False; -- GNATMAKE, GPRMAKE, GPRBUILD diff --git a/gcc/ada/sem.adb b/gcc/ada/sem.adb index 2dd4c3a13d1..79cb3ee1a9d 100644 --- a/gcc/ada/sem.adb +++ b/gcc/ada/sem.adb @@ -1936,7 +1936,6 @@ package body Sem is if Is_Child_Unit (Cunit_Entity (Main_Unit)) then Child := Cunit_Entity (Main_Unit); - while Is_Child_Unit (Child) loop Parent_CU := Cunit (Get_Cunit_Entity_Unit_Number (Scope (Child))); diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 97e38230fa5..16cd00983bc 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -2030,10 +2030,13 @@ package body Sem_Ch6 is end if; end if; - -- Mark presence of postcondition proc in current scope + -- Mark presence of postcondition procedure in current scope and mark + -- the procedure itself as needing debug info. The latter is important + -- when analyzing decision coverage (for example, for MC/DC coverage). if Chars (Body_Id) = Name_uPostconditions then Set_Has_Postconditions (Current_Scope); + Set_Debug_Info_Needed (Body_Id); end if; -- Place subprogram on scope stack, and make formals visible. If there diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb index 27505f215a9..c4310cd35f9 100644 --- a/gcc/ada/sem_ch7.adb +++ b/gcc/ada/sem_ch7.adb @@ -2032,6 +2032,10 @@ package body Sem_Ch7 is end if; Set_Has_Discriminants (Priv, Has_Discriminants (Full)); + if Has_Discriminants (Full) then + Set_Discriminant_Constraint (Priv, + Discriminant_Constraint (Full)); + end if; end if; end Preserve_Full_Attributes; diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb index ebe5947c0d4..a07e9839d1b 100644 --- a/gcc/ada/sem_elab.adb +++ b/gcc/ada/sem_elab.adb @@ -1892,7 +1892,7 @@ package body Sem_Elab is elsif In_Task_Activation then return; - -- Nothing to do if call is within a generic unit. + -- Nothing to do if call is within a generic unit elsif Inside_A_Generic then return; |
