[multiple changes]

2016-04-27  Arnaud Charlet  <charlet@adacore.com>

	* sem_ch10.adb, sem_case.adb: Mark messages udner -gnatwr when needed.

2016-04-27  Hristian Kirtchev  <kirtchev@adacore.com>

	* errout.adb, errutil.adb: Minor reformatting.

2016-04-27  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch13.adb (Analyze_Aspect_Specifications, case Pre/Post):
	Check that the classwide version is illegal when the prefix is
	an operation of an untagged synchronized type.

From-SVN: r235504

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index a69659d6e3dadbe8711b38609ded294219032818..0a0f0390c7eaace827913c77d7a658dd29e24208 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,17 @@
+2016-04-27  Arnaud Charlet  <charlet@adacore.com>
+
+       * sem_ch10.adb, sem_case.adb: Mark messages udner -gnatwr when needed.
+
+2016-04-27  Hristian Kirtchev  <kirtchev@adacore.com>
+
+       * errout.adb, errutil.adb: Minor reformatting.
+
+2016-04-27  Ed Schonberg  <schonberg@adacore.com>
+
+       * sem_ch13.adb (Analyze_Aspect_Specifications, case Pre/Post):
+       Check that the classwide version is illegal when the prefix is
+       an operation of an untagged synchronized type.
+
 2016-04-27  Arnaud Charlet  <charleT@adacore.com>
 
        * sinput-l.ads, sem_ch13.adb: Minor editing.

diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb
index a0032810dab7700149b0de8242fe6f43cb98aaee..1c794de3c9b075576a896bcd6ad2855f6cc08e08 100644 (file)
--- a/gcc/ada/errout.adb
+++ b/gcc/ada/errout.adb
@@ -3082,6 +3082,7 @@ package body Errout is
 
    begin
       if Is_Serious_Error then
+
          --  We always set Error_Posted on the node itself
 
          Set_Error_Posted (N);

diff --git a/gcc/ada/errutil.adb b/gcc/ada/errutil.adb
index d4e951079210dd603fa3750c662abe2cb913a0b0..3a8f0fbf5d8671f870350ad481f8481b2e2dfd56 100644 (file)
--- a/gcc/ada/errutil.adb
+++ b/gcc/ada/errutil.adb
@@ -314,8 +314,7 @@ package body Errutil is
          end if;
 
       elsif Errors.Table (Cur_Msg).Warn
-           or else
-         Errors.Table (Cur_Msg).Style
+        or else Errors.Table (Cur_Msg).Style
       then
          Warnings_Detected := Warnings_Detected + 1;
 

diff --git a/gcc/ada/sem_case.adb b/gcc/ada/sem_case.adb
index ee845ee19475b29863f3d4e8be389589726bff03..8df46f067deabf05b058f5545783ff2c7ffaa224 100644 (file)
--- a/gcc/ada/sem_case.adb
+++ b/gcc/ada/sem_case.adb
@@ -1128,10 +1128,7 @@ package body Sem_Case is
    procedure No_OP (C : Node_Id) is
    begin
       if Nkind (C) = N_Range and then Warn_On_Redundant_Constructs then
-         Error_Msg_N ("choice is an empty range?", C);
-
-      else
-         null;
+         Error_Msg_N ("choice is an empty range?r?", C);
       end if;
    end No_OP;
 

diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb
index c02cd4f4e56a1e24fbb24cf607cdbe6ed91fda42..5ab4afb4be8ae5e9be14344edffc6b5889267abc 100644 (file)
--- a/gcc/ada/sem_ch10.adb
+++ b/gcc/ada/sem_ch10.adb
@@ -557,7 +557,7 @@ package body Sem_Ch10 is
                                   or else Used_In_Spec)
                      then
                         Error_Msg_N -- CODEFIX
-                          ("redundant with clause in body??", Clause);
+                          ("redundant with clause in body?r?", Clause);
                      end if;
 
                      Used_In_Body := False;
@@ -586,7 +586,7 @@ package body Sem_Ch10 is
 
                      if Withed then
                         Error_Msg_N -- CODEFIX
-                          ("redundant with clause??", Clause);
+                          ("redundant with clause?r?", Clause);
                      end if;
                   end;
                end if;

diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 8afc5429e484c02871e57c07804b8a3671d9021a..54cc886a6a5ad003b34a524c794c0c71fab9285d 100644 (file)
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -3129,6 +3129,24 @@ package body Sem_Ch13 is
                      Pname := Name_Postcondition;
                   end if;
 
+                  --  Check that the class-wide predicate cannot be applied to
+                  --  an operation of a synchronized type that is not a tagged
+                  --  type. Other legality checks are performed when analyzing
+                  --  the contract of the operation.
+
+                  if Class_Present (Aspect)
+                    and then Is_Concurrent_Type (Current_Scope)
+                    and then not Is_Tagged_Type (Current_Scope)
+                    and then Ekind_In (E, E_Entry, E_Function, E_Procedure)
+                  then
+                     Error_Msg_Name_1 := Original_Aspect_Pragma_Name (Aspect);
+                     Error_Msg_N
+                       ("aspect % can only be specified for a primitive "
+                        & "operation of a tagged type", Aspect);
+
+                     goto Continue;
+                  end if;
+
                   --  If the expressions is of the form A and then B, then
                   --  we generate separate Pre/Post aspects for the separate
                   --  clauses. Since we allow multiple pragmas, there is no