diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 37 | ||||
| -rw-r--r-- | gcc/ada/ali.ads | 20 | ||||
| -rw-r--r-- | gcc/ada/exp_intr.adb | 23 | ||||
| -rw-r--r-- | gcc/ada/exp_intr.ads | 16 | ||||
| -rw-r--r-- | gcc/ada/g-souinf.ads | 6 | ||||
| -rw-r--r-- | gcc/ada/sem_aggr.adb | 27 | ||||
| -rw-r--r-- | gcc/ada/sem_intr.adb | 1 | ||||
| -rw-r--r-- | gcc/ada/sem_prag.adb | 20 | ||||
| -rw-r--r-- | gcc/ada/sem_warn.adb | 8 | ||||
| -rw-r--r-- | gcc/ada/snames.ads-tmpl | 1 |
10 files changed, 115 insertions, 44 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 0d7e257..cea9413 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,40 @@ +2016-04-18 Ed Schonberg <schonberg@adacore.com> + + * sem_aggr.adb (Resolve_Record_Aggregate): If + Warn_On_Redundant_Constructs is enabled, report a redundant box + association that does not cover any components, as it done for + redundant others associations in case statements. + +2016-04-18 Ed Schonberg <schonberg@adacore.com> + + * sem_prag.adb (Collect_Inherited_Class_Wide_Conditions): + Analyze the generated Check pragma for an inherited condition so + that it does not freeze the dispatching type of the primitive + operation, because it is pre-analyzed at the point of the + subprogram declaration (and not in the subprogram body, as is + done during regular expansion). + +2016-04-18 Vincent Celier <celier@adacore.com> + + * ali.ads: Increase the range of all _Id types to 100 millions. + +2016-04-18 Gary Dismukes <dismukes@adacore.com> + + * sem_warn.adb (Check_References): Change warning to suggest + using pragma Export rather than saying "volatile has no effect". + +2016-04-18 Bob Duff <duff@adacore.com> + + * g-souinf.ads (Compilation_ISO_Date): New function to return + the current date in ISO form. + * exp_intr.adb (Expand_Source_Info, Add_Source_Info): Expand + a call to Compilation_ISO_Date into a string literal containing + the current date in ISO form. + * exp_intr.ads (Add_Source_Info): Improve documentation. + * sem_intr.adb (Check_Intrinsic_Subprogram): Recognize + Compilation_ISO_Date. + * snames.ads-tmpl (Name_Compilation_ISO_Date): New Name_Id. + 2016-04-18 Eric Botcazou <ebotcazou@adacore.com> * layout.adb (Set_Elem_Alignment): Extend setting of alignment diff --git a/gcc/ada/ali.ads b/gcc/ada/ali.ads index 96f6bd5..eea6b46 100644 --- a/gcc/ada/ali.ads +++ b/gcc/ada/ali.ads @@ -42,32 +42,28 @@ package ALI is -- Id Types -- -------------- - -- The various entries are stored in tables with distinct subscript ranges. - -- The following type definitions show the ranges used for the subscripts - -- (Id values) for the various tables. - - type ALI_Id is range 0 .. 999_999; + type ALI_Id is range 0 .. 99_999_999; -- Id values used for ALIs table entries - type Unit_Id is range 1_000_000 .. 1_999_999; + type Unit_Id is range 0 .. 99_999_999; -- Id values used for Unit table entries - type With_Id is range 2_000_000 .. 2_999_999; + type With_Id is range 0 .. 99_999_999; -- Id values used for Withs table entries - type Arg_Id is range 3_000_000 .. 3_999_999; + type Arg_Id is range 0 .. 99_999_999; -- Id values used for argument table entries - type Sdep_Id is range 4_000_000 .. 4_999_999; + type Sdep_Id is range 0 .. 99_999_999; -- Id values used for Sdep table entries - type Source_Id is range 5_000_000 .. 5_999_999; + type Source_Id is range 0 .. 99_999_999; -- Id values used for Source table entries - type Interrupt_State_Id is range 6_000_000 .. 6_999_999; + type Interrupt_State_Id is range 0 .. 99_999_999; -- Id values used for Interrupt_State table entries - type Priority_Specific_Dispatching_Id is range 7_000_000 .. 7_999_999; + type Priority_Specific_Dispatching_Id is range 0 .. 99_999_999; -- Id values used for Priority_Specific_Dispatching table entries -------------------- diff --git a/gcc/ada/exp_intr.adb b/gcc/ada/exp_intr.adb index beaa24a..b8f1fe4 100644 --- a/gcc/ada/exp_intr.adb +++ b/gcc/ada/exp_intr.adb @@ -107,14 +107,10 @@ package body Exp_Intr is -- System.Address_To_Access_Conversions. procedure Expand_Source_Info (N : Node_Id; Nam : Name_Id); - -- Rewrite the node by the appropriate string or positive constant. - -- Nam can be one of the following: - -- Name_File - expand string name of source file - -- Name_Line - expand integer line number - -- Name_Source_Location - expand string of form file:line - -- Name_Enclosing_Entity - expand string name of enclosing entity - -- Name_Compilation_Date - expand string with compilation date - -- Name_Compilation_Time - expand string with compilation time + -- Rewrite the node as the appropriate string literal or positive + -- constant. Nam is the name of one of the intrinsics declared in + -- GNAT.Source_Info; see g-souinf.ads for documentation of these + -- intrinsics. procedure Write_Entity_Name (E : Entity_Id); -- Recursive procedure to construct string for qualified name of enclosing @@ -165,6 +161,10 @@ package body Exp_Intr is Write_Entity_Name (Ent); + when Name_Compilation_ISO_Date => + Name_Buffer (1 .. 10) := Opt.Compilation_Time (1 .. 10); + Name_Len := 10; + when Name_Compilation_Date => declare subtype S13 is String (1 .. 3); @@ -696,6 +696,7 @@ package body Exp_Intr is Name_Line, Name_Source_Location, Name_Enclosing_Entity, + Name_Compilation_ISO_Date, Name_Compilation_Date, Name_Compilation_Time) then @@ -851,6 +852,8 @@ package body Exp_Intr is ------------------------ procedure Expand_Source_Info (N : Node_Id; Nam : Name_Id) is + -- ???There is duplicated code here (see Add_Source_Info) + Loc : constant Source_Ptr := Sloc (N); Ent : Entity_Id; @@ -891,6 +894,10 @@ package body Exp_Intr is Write_Entity_Name (Ent); + when Name_Compilation_ISO_Date => + Name_Buffer (1 .. 10) := Opt.Compilation_Time (1 .. 10); + Name_Len := 10; + when Name_Compilation_Date => declare subtype S13 is String (1 .. 3); diff --git a/gcc/ada/exp_intr.ads b/gcc/ada/exp_intr.ads index f9be797..5ba0769 100644 --- a/gcc/ada/exp_intr.ads +++ b/gcc/ada/exp_intr.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2015, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -31,15 +31,11 @@ with Types; use Types; package Exp_Intr is procedure Add_Source_Info (Loc : Source_Ptr; Nam : Name_Id); - -- Append a string to Name_Buffer depending on Nam - -- Name_File - append name of source file - -- Name_Line - append line number - -- Name_Source_Location - append source location (file:line) - -- Name_Enclosing_Entity - append name of enclosing entity - -- Name_Compilation_Date - append compilation date - -- Name_Compilation_Time - append compilation time - -- The caller must set Name_Buffer and Name_Len before the call. Loc is - -- passed to provide location information where it is needed. + -- Append a string to Name_Buffer depending on Nam, which is the name of + -- one of the intrinsics declared in GNAT.Source_Info; see g-souinf.ads for + -- documentation of these intrinsics. The caller must set Name_Buffer and + -- Name_Len before the call. Loc is passed to provide location information + -- where it is needed. procedure Expand_Intrinsic_Call (N : Node_Id; E : Entity_Id); -- N is either a function call node, a procedure call statement node, or diff --git a/gcc/ada/g-souinf.ads b/gcc/ada/g-souinf.ads index 610db23..83d23d4 100644 --- a/gcc/ada/g-souinf.ads +++ b/gcc/ada/g-souinf.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2000-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 2000-2015, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -79,6 +79,10 @@ package GNAT.Source_Info is -- package itself. This is useful in identifying and logging information -- from within generic templates. + function Compilation_ISO_Date return String with + Import, Convention => Intrinsic; + -- Returns date of compilation as a static string "yyyy-mm-dd". + function Compilation_Date return String with Import, Convention => Intrinsic; -- Returns date of compilation as a static string "mmm dd yyyy". This is diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb index 60cd131..8e8b398 100644 --- a/gcc/ada/sem_aggr.adb +++ b/gcc/ada/sem_aggr.adb @@ -2972,14 +2972,20 @@ package body Sem_Aggr is -- -- This variable is updated as a side effect of function Get_Value. + Box_Node : Node_Id; Is_Box_Present : Boolean := False; - Others_Box : Boolean := False; + Others_Box : Integer := 0; + -- Ada 2005 (AI-287): Variables used in case of default initialization -- to provide a functionality similar to Others_Etype. Box_Present -- indicates that the component takes its default initialization; - -- Others_Box indicates that at least one component takes its default - -- initialization. Similar to Others_Etype, they are also updated as a + -- Others_Box counts the number of components of the current aggregate + -- (which may be a sub-aggregate of a larger one) that are default- + -- initialized. A value of One indicates that an others_box is present. + -- Any larger value indicates that the others_box is not redundant. + -- These variables, similar to Others_Etype, are also updated as a -- side effect of function Get_Value. + -- Box_Node is used to place a warning on a redundant others_box. procedure Add_Association (Component : Entity_Id; @@ -3231,7 +3237,7 @@ package body Sem_Aggr is -- checks when the default includes function calls. if Box_Present (Assoc) then - Others_Box := True; + Others_Box := Others_Box + 1; Is_Box_Present := True; if Expander_Active then @@ -3704,7 +3710,8 @@ package body Sem_Aggr is -- any component. elsif Box_Present (Assoc) then - Others_Box := True; + Others_Box := 1; + Box_Node := Assoc; end if; else @@ -4439,7 +4446,8 @@ package body Sem_Aggr is Comp_Elmt := First_Elmt (Components); while Present (Comp_Elmt) loop - if Ekind (Node (Comp_Elmt)) /= E_Discriminant + if + Ekind (Node (Comp_Elmt)) /= E_Discriminant then Process_Component (Node (Comp_Elmt)); end if; @@ -4585,9 +4593,14 @@ package body Sem_Aggr is -- Ada 2005 (AI-287): others choice may have expression or box - if No (Others_Etype) and then not Others_Box then + if No (Others_Etype) and then Others_Box = 0 then Error_Msg_N ("OTHERS must represent at least one component", Selectr); + + elsif Others_Box = 1 and then Warn_On_Redundant_Constructs then + Error_Msg_N ("others choice is redundant?", Box_Node); + Error_Msg_N ("\previous choices cover all components?", + Box_Node); end if; exit Verification; diff --git a/gcc/ada/sem_intr.adb b/gcc/ada/sem_intr.adb index 69a1d5f..e25ebb7 100644 --- a/gcc/ada/sem_intr.adb +++ b/gcc/ada/sem_intr.adb @@ -359,6 +359,7 @@ package body Sem_Intr is Name_Line, Name_Source_Location, Name_Enclosing_Entity, + Name_Compilation_ISO_Date, Name_Compilation_Date, Name_Compilation_Time) then diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 173b14b..0197159 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -26762,9 +26762,10 @@ package body Sem_Prag is procedure Collect_Inherited_Class_Wide_Conditions (Subp : Entity_Id) is Parent_Subp : constant Entity_Id := Overridden_Operation (Subp); Prags : constant Node_Id := Contract (Parent_Subp); - Prag : Node_Id; - New_Prag : Node_Id; - Installed : Boolean; + Prag : Node_Id; + New_Prag : Node_Id; + Installed : Boolean; + In_Spec_Expr : Boolean; begin Installed := False; @@ -26781,24 +26782,35 @@ package body Sem_Prag is and then Class_Present (Prag) then -- The generated pragma must be analyzed in the context of - -- the subprogram, to make its formals visible. + -- the subprogram, to make its formals visible. In addition, + -- we must inhibit freezing and full analysis because the + -- controlling type of the subprogram is not frozen yet, and + -- may have further primitives. if not Installed then Installed := True; Push_Scope (Subp); Install_Formals (Subp); + In_Spec_Expr := In_Spec_Expression; + In_Spec_Expression := True; end if; New_Prag := Build_Pragma_Check_Equivalent (Prag, Subp, Parent_Subp); Insert_After (Unit_Declaration_Node (Subp), New_Prag); Preanalyze (New_Prag); + + -- Prevent further analysis in subsequent processing of the + -- current list of declarations + + Set_Analyzed (New_Prag); end if; Prag := Next_Pragma (Prag); end loop; if Installed then + In_Spec_Expression := In_Spec_Expr; End_Scope; end if; end if; diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb index 18b4e91..a2fb50d 100644 --- a/gcc/ada/sem_warn.adb +++ b/gcc/ada/sem_warn.adb @@ -1137,13 +1137,17 @@ package body Sem_Warn is -- A special case, if this variable is volatile and not -- imported, it is not helpful to tell the programmer -- to mark the variable as constant, since this would be - -- illegal by virtue of RM C.6(13). + -- illegal by virtue of RM C.6(13). Instead we suggest + -- using pragma Export (can't be Import because of the + -- initial value). if (Is_Volatile (E1) or else Has_Volatile_Components (E1)) and then not Is_Imported (E1) then Error_Msg_N - ("?k?& is not modified, volatile has no effect!", E1); + ("?k?& is not modified, " & + "consider pragma Export for volatile variable!", + E1); -- Another special case, Exception_Occurrence, this catches -- the case of exception choice (and a bit more too, but not diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl index 1087806..e52a181 100644 --- a/gcc/ada/snames.ads-tmpl +++ b/gcc/ada/snames.ads-tmpl @@ -1204,6 +1204,7 @@ package Snames is -- convention name. So is To_Address, which is a GNAT attribute. First_Intrinsic_Name : constant Name_Id := N + $; + Name_Compilation_ISO_Date : constant Name_Id := N + $; Name_Compilation_Date : constant Name_Id := N + $; Name_Compilation_Time : constant Name_Id := N + $; Name_Divide : constant Name_Id := N + $; |