[multiple changes]

2014-01-20  Robert Dewar  <dewar@adacore.com>

	* errout.ads, errout.adb: Implement >? >x? >X? sequences in error
	messages.
	* sem_ch6.adb (Check_Statement_Sequence): Missing return is an
	error in GNATprove mode.

2014-01-20  Ed Schonberg  <schonberg@adacore.com>

	* par-ch4.adb (Is_Parameterless_Attribute): The Ada2012 attribute
	reference 'Old takes no parameters, and thus can appear as a
	prefix of a slice.

2014-01-20  Eric Botcazou  <ebotcazou@adacore.com>

	* exp_aggr.adb: Fix minor typos.

From-SVN: r206839

6 files changed, 61 insertions, 30 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 4b1d4c9..d73b2ee 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,20 @@
+2014-01-20  Robert Dewar  <dewar@adacore.com>
+
+	* errout.ads, errout.adb: Implement >? >x? >X? sequences in error
+	messages.
+	* sem_ch6.adb (Check_Statement_Sequence): Missing return is an
+	error in GNATprove mode.
+
+2014-01-20  Ed Schonberg  <schonberg@adacore.com>
+
+	* par-ch4.adb (Is_Parameterless_Attribute): The Ada2012 attribute
+	reference 'Old takes no parameters, and thus can appear as a
+	prefix of a slice.
+
+2014-01-20  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* exp_aggr.adb: Fix minor typos.
+
 2014-01-20  Ed Schonberg  <schonberg@adacore.com>
 
 	* sem_attr.adb (Analyze_Attribute, case 'Constrained): In an
diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb
index 78193ff..6679d6a 100644
--- a/gcc/ada/errout.adb
+++ b/gcc/ada/errout.adb
@@ -2713,7 +2713,8 @@ package body Errout is
       P : Natural;     -- Current index;
 
       procedure Set_Msg_Insertion_Warning;
-      --  Deal with ? ?? ?x? ?X? insertion sequences
+      --  Deal with ? ?? ?x? ?X? insertion sequences (also < <? <x? <X?). The
+      --  caller has already bumped the pointer past the initial ? or <.
 
       -------------------------------
       -- Set_Msg_Insertion_Warning --
@@ -2819,14 +2820,12 @@ package body Errout is
 
             when '<' =>
 
-               --  If tagging of messages is enabled, and this is a warning,
-               --  then it is treated as being [enabled by default].
+               --  Note: the prescan already set Is_Warning_Msg True if and
+               --  only if Error_Msg_Warn is set to True. If Error_Msg_Warn
+               --  is False, the call to Set_Msg_Insertion_Warning here does
+               --  no harm, since Warning_Msg_Char is ignored in that case.
 
-               if Error_Msg_Warn
-                 and Warning_Doc_Switch
-               then
-                  Warning_Msg_Char := '?';
-               end if;
+               Set_Msg_Insertion_Warning;
 
             when '|' =>
                null; -- already dealt with
diff --git a/gcc/ada/errout.ads b/gcc/ada/errout.ads
index 0561329..4ae3904 100644
--- a/gcc/ada/errout.ads
+++ b/gcc/ada/errout.ads
@@ -64,7 +64,6 @@ package Errout is
    --  are active (see errout.ads for details). If this switch is False, then
    --  these sequences are ignored (i.e. simply equivalent to a single ?). The
    --  -gnatw.d switch sets this flag True, -gnatw.D sets this flag False.
-   --  Note: always ignored in VMS mode where we do not provide this feature.
 
    -----------------------------------
    -- Suppression of Error Messages --
@@ -305,8 +304,10 @@ package Errout is
    --    Insertion character < (Less Than: conditional warning message)
    --      The character < appearing anywhere in a message is used for a
    --      conditional error message. If Error_Msg_Warn is True, then the
-   --      effect is the same as ? described above. If Error_Msg_Warn is
-   --      False, then there is no effect.
+   --      effect is the same as ? described above, and in particular <? and
+   --      <X? have the effect of ?? and ?X? respectively. If Error_Msg_Warn
+   --      is False, then the < <? or <X? sequence is ignored and the message
+   --      is treated as a error rather than a warning.
 
    --    Insertion character A-Z (Upper case letter: Ada reserved word)
    --      If two or more upper case letters appear in the message, they are
diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index 20a82b1..0fcebd6 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -81,7 +81,7 @@ package body Exp_Aggr is
 
    function Is_Static_Dispatch_Table_Aggregate (N : Node_Id) return Boolean;
    --  Returns true if N is an aggregate used to initialize the components
-   --  of an statically allocated dispatch table.
+   --  of a statically allocated dispatch table.
 
    function Must_Slide
      (Obj_Type : Entity_Id;
@@ -150,7 +150,7 @@ package body Exp_Aggr is
    --      aggregate
 
    function Has_Mutable_Components (Typ : Entity_Id) return Boolean;
-   --  Return true if one of the component is of a discriminated type with
+   --  Return true if one of the components is of a discriminated type with
    --  defaults. An aggregate for a type with mutable components must be
    --  expanded into individual assignments.
 
@@ -183,7 +183,7 @@ package body Exp_Aggr is
 
    function Backend_Processing_Possible (N : Node_Id) return Boolean;
    --  This function checks if array aggregate N can be processed directly
-   --  by the backend. If this is the case True is returned.
+   --  by the backend. If this is the case, True is returned.
 
    function Build_Array_Aggr_Code
      (N           : Node_Id;
@@ -3918,7 +3918,7 @@ package body Exp_Aggr is
    --             corresponding to the same dimension have the same bounds.
 
    --  2. Check for packed array aggregate which can be converted to a
-   --     constant so that the aggregate disappeares completely.
+   --     constant so that the aggregate disappears completely.
 
    --  3. Check case of nested aggregate. Generally nested aggregates are
    --     handled during the processing of the parent aggregate.
@@ -4964,7 +4964,7 @@ package body Exp_Aggr is
 
       --  If all aggregate components are compile-time known and the aggregate
       --  has been flattened, nothing left to do. The same occurs if the
-      --  aggregate is used to initialize the components of an statically
+      --  aggregate is used to initialize the components of a statically
       --  allocated dispatch table.
 
       if Compile_Time_Known_Aggregate (N)
@@ -5282,7 +5282,7 @@ package body Exp_Aggr is
          --  form, but there are two problems with that circuit:
 
          --    a) It is limited to very small cases due to ill-understood
-         --       interations with bootstrapping. That limit is removed by
+         --       interactions with bootstrapping. That limit is removed by
          --       use of the No_Implicit_Loops restriction.
 
          --    b) It erroneously ends up with the resulting expressions being
@@ -5445,7 +5445,7 @@ package body Exp_Aggr is
       --  set and constants whose expression is such an aggregate, recursively.
 
       function Component_Not_OK_For_Backend return Boolean;
-      --  Check for presence of component which makes it impossible for the
+      --  Check for presence of a component which makes it impossible for the
       --  backend to process the aggregate, thus requiring the use of a series
       --  of assignment statements. Cases checked for are a nested aggregate
       --  needing Late_Expansion, the presence of a tagged component which may
@@ -5466,7 +5466,7 @@ package body Exp_Aggr is
 
       function Has_Visible_Private_Ancestor (Id : E) return Boolean;
       --  If any ancestor of the current type is private, the aggregate
-      --  cannot be built in place. We canot rely on Has_Private_Ancestor,
+      --  cannot be built in place. We cannot rely on Has_Private_Ancestor,
       --  because it will not be set when type and its parent are in the
       --  same scope, and the parent component needs expansion.
 
@@ -5751,13 +5751,13 @@ package body Exp_Aggr is
       then
          Convert_To_Assignments (N, Typ);
 
-      --  If the type involved has any non-bit aligned components, then we are
-      --  not sure that the back end can handle this case correctly.
+      --  If the type involved has bit aligned components, then we are not sure
+      --  that the back end can handle this case correctly.
 
       elsif Type_May_Have_Bit_Aligned_Components (Typ) then
          Convert_To_Assignments (N, Typ);
 
-      --  In all other cases, build a proper aggregate handlable by gigi
+      --  In all other cases, build a proper aggregate to be handled by gigi
 
       else
          if Nkind (N) = N_Aggregate then
@@ -6378,7 +6378,7 @@ package body Exp_Aggr is
          --  At this stage we have a suitable aggregate for handling at compile
          --  time. The only remaining checks are that the values of expressions
          --  in the aggregate are compile-time known (checks are performed by
-         --  Get_Component_Val, and that any subtypes or ranges are statically
+         --  Get_Component_Val), and that any subtypes or ranges are statically
          --  known.
 
          --  If the aggregate is not fully positional at this stage, then
diff --git a/gcc/ada/par-ch4.adb b/gcc/ada/par-ch4.adb
index cdf0dab..5981f01 100644
--- a/gcc/ada/par-ch4.adb
+++ b/gcc/ada/par-ch4.adb
@@ -41,6 +41,7 @@ package body Ch4 is
       Attribute_External_Tag => True,
       Attribute_Img          => True,
       Attribute_Loop_Entry   => True,
+      Attribute_Old          => True,
       Attribute_Stub_Type    => True,
       Attribute_Version      => True,
       Attribute_Type_Key     => True,
@@ -49,7 +50,8 @@ package body Ch4 is
    --  string or a type. For those attributes, a left parenthesis after
    --  the attribute should not be analyzed as the beginning of a parameters
    --  list because it may denote a slice operation (X'Img (1 .. 2)) or
-   --  a type conversion (X'Class (Y)).
+   --  a type conversion (X'Class (Y)). The Ada2012 attribute 'Old is in
+   --  this category.
 
    --  Note: Loop_Entry is in this list because, although it can take an
    --  optional argument (the loop name), we can't distinguish that at parse
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 9555dd1..3105ac1 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -7222,12 +7222,24 @@ package body Sem_Ch6 is
 
          if Mode = 'F' then
             if not Raise_Exception_Call then
-               Error_Msg_N
-                 ("RETURN statement missing following this statement??!",
-                  Last_Stm);
-               Error_Msg_N
-                 ("\Program_Error may be raised at run time??!",
-                  Last_Stm);
+
+               --  In GNATprove mode, it is an error to have a missing return
+
+               if GNATprove_Mode then
+                  Error_Msg_N
+                    ("RETURN statement missing following this statement!",
+                     Last_Stm);
+
+               --  Otherwise normal case of warning (RM insists this is legal)
+
+               else
+                  Error_Msg_N
+                    ("RETURN statement missing following this statement??!",
+                     Last_Stm);
+                  Error_Msg_N
+                    ("\Program_Error may be raised at run time??!",
+                     Last_Stm);
+               end if;
             end if;
 
             --  Note: we set Err even though we have not issued a warning