[multiple changes]

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

	* sem_ch3.adb, sem_prag.adb, sem_prag.ads, sem_ch12.adb, sem_res.adb,
	sem_ch6.adb, a-except-2005.adb: Minor reformatting.

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

	* exp_ch3.adb (Expand_N_Object_Declaration): When a class-wide
	object is declared, it is rewritten as a renaming of an dynamic
	expression that wraps the initial value.  The renaming declaration
	is first given an internal name, to prevent collisions with the
	entity already declared, and then the name is modified to reflect
	the original one. the modification of the name must preserve
	the source location of the original, to prevent spurious errors
	when compiling with style checks if the declaration involves
	more than one entity.

From-SVN: r206887

9 files changed, 53 insertions, 22 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 2fbcd79..6bb46e7 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,20 @@
+2014-01-21  Robert Dewar  <dewar@adacore.com>
+
+	* sem_ch3.adb, sem_prag.adb, sem_prag.ads, sem_ch12.adb, sem_res.adb,
+	sem_ch6.adb, a-except-2005.adb: Minor reformatting.
+
+2014-01-21  Ed Schonberg  <schonberg@adacore.com>
+
+	* exp_ch3.adb (Expand_N_Object_Declaration): When a class-wide
+	object is declared, it is rewritten as a renaming of an dynamic
+	expression that wraps the initial value.  The renaming declaration
+	is first given an internal name, to prevent collisions with the
+	entity already declared, and then the name is modified to reflect
+	the original one. the modification of the name must preserve
+	the source location of the original, to prevent spurious errors
+	when compiling with style checks if the declaration involves
+	more than one entity.
+
 2014-01-21  Hristian Kirtchev  <kirtchev@adacore.com>
 
 	* aspects.adb Add entries for Async_Readers, Async_Writers,
diff --git a/gcc/ada/a-except-2005.adb b/gcc/ada/a-except-2005.adb
index b47f167..4fc60e5 100644
--- a/gcc/ada/a-except-2005.adb
+++ b/gcc/ada/a-except-2005.adb
@@ -991,11 +991,14 @@ package body Ada.Exceptions is
       Message : String := "")
    is
       X : constant EOA := Exception_Propagation.Allocate_Occurrence;
+
    begin
       Exception_Data.Set_Exception_Msg (X, E, Message);
+
       if not ZCX_By_Default then
          Abort_Defer.all;
       end if;
+
       Complete_And_Propagate_Occurrence (X);
    end Raise_Exception_Always;
 
@@ -1527,6 +1530,7 @@ package body Ada.Exceptions is
       if not ZCX_By_Default then
          Abort_Defer.all;
       end if;
+
       Save_Occurrence (Excep.all, Get_Current_Excep.all.all);
       Excep.Machine_Occurrence := Saved_MO;
       Complete_And_Propagate_Occurrence (Excep);
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index 4a0fdf6..ce7f01f 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -5504,7 +5504,9 @@ package body Exp_Ch3 is
                   --  itypes may have been generated already, and the full
                   --  chain must be preserved for final freezing. Finally,
                   --  preserve Comes_From_Source setting, so that debugging
-                  --  and cross-referencing information is properly kept.
+                  --  and cross-referencing information is properly kept, and
+                  --  preserve source location, to prevent spurious errors when
+                  --  entities are declared (they must have their own Sloc).
 
                   declare
                      New_Id    : constant Entity_Id := Defining_Identifier (N);
@@ -5519,6 +5521,7 @@ package body Exp_Ch3 is
                      Set_Chars   (Defining_Identifier (N), Chars   (Def_Id));
                      Set_Homonym (Defining_Identifier (N), Homonym (Def_Id));
                      Set_Ekind   (Defining_Identifier (N), Ekind   (Def_Id));
+                     Set_Sloc    (Defining_Identifier (N), Sloc    (Def_Id));
 
                      Set_Comes_From_Source (Def_Id, False);
                      Exchange_Entities (Defining_Identifier (N), Def_Id);
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index 1f030d9..0e2787f 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -9844,6 +9844,9 @@ package body Sem_Ch12 is
       --  it is not a standard Ada legality rule. A volatile object cannot be
       --  used as an actual in a generic instantiation.
 
+      --  Should mention that this is a rule for SPARK only, perhaps with
+      --  a SPARK RM reference???
+
       if GNATprove_Mode and then Is_Volatile_Object (Actual) then
          Error_Msg_N
            ("volatile object cannot act as actual in generic instantiation",
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index f40d1cf..99f85cb 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -93,8 +93,8 @@ package body Sem_Ch3 is
 
    procedure Analyze_Variable_Contract (Var_Id : Entity_Id);
    --  Analyze all delayed aspects chained on the contract of variable Var_Id
-   --  as if they appeared at the end of the declarative region. The aspects in
-   --  consideration are:
+   --  as if they appeared at the end of the declarative region. The aspects
+   --  to be considered are:
    --    Async_Readers
    --    Async_Writers
    --    Effective_Reads
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 91efb6f..edf2c84 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -11121,6 +11121,8 @@ package body Sem_Ch6 is
          --  as it is not a standard Ada legality rule. A function cannot have
          --  a volatile formal parameter.
 
+         --  Need to mention this is a SPARK rule, with SPARK RM reference ???
+
          if GNATprove_Mode
            and then Is_Volatile_Object (Formal)
            and then Ekind_In (Scope (Formal), E_Function, E_Generic_Function)
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 8148c46..54ef5f3 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -9526,8 +9526,7 @@ package body Sem_Prag is
             Null_Seen     : Boolean := False;
 
             Pack_Id : Entity_Id;
-            --  The entity of the related package when pragma Abstract_State
-            --  appears.
+            --  Entity of related package when pragma Abstract_State appears
 
             procedure Analyze_Abstract_State (State : Node_Id);
             --  Verify the legality of a single state declaration. Create and
@@ -9659,7 +9658,7 @@ package body Sem_Prag is
 
                begin
                   --  The external property must be one of the predefined four
-                  --  reader / writer choices.
+                  --  reader/writer choices.
 
                   if Nkind (Prop) /= N_Identifier
                     or else not Nam_In (Chars (Prop), Name_Async_Readers,
@@ -9721,8 +9720,7 @@ package body Sem_Prag is
 
                   Analyze (Par_State);
 
-                  --  The expression of option Part_Of must denote an abstract
-                  --  state.
+                  --  Expression of option Part_Of must denote abstract state
 
                   if not Is_Entity_Name (Par_State)
                     or else No (Entity (Par_State))
@@ -22527,34 +22525,34 @@ package body Sem_Prag is
    begin
       --  All properties enabled
 
-      if AR and then AW and then ER and then EW then
+      if AR and AW and ER and EW then
          null;
 
       --  Async_Readers + Effective_Writes
       --  Async_Readers + Async_Writers + Effective_Writes
 
-      elsif AR and then EW and then not ER then
+      elsif AR and EW and not ER then
          null;
 
       --  Async_Writers + Effective_Reads
       --  Async_Readers + Async_Writers + Effective_Reads
 
-      elsif AW and then ER and then not EW then
+      elsif AW and ER and not EW then
          null;
 
       --  Async_Readers + Async_Writers
 
-      elsif AR and then AW and then not ER and then not EW then
+      elsif AR and AW and not ER and not EW then
          null;
 
       --  Async_Readers
 
-      elsif AR and then not AW and then not ER and then not EW then
+      elsif AR and not AW and not ER and not EW then
          null;
 
       --  Async_Writers
 
-      elsif AW and then not AR and then not ER and then not EW then
+      elsif AW and not AR and not ER and not EW then
          null;
 
       else
diff --git a/gcc/ada/sem_prag.ads b/gcc/ada/sem_prag.ads
index bb57d99..6d1a01a 100644
--- a/gcc/ada/sem_prag.ads
+++ b/gcc/ada/sem_prag.ads
@@ -136,8 +136,8 @@ package Sem_Prag is
       EW   : Boolean);
    --  Flags AR, AW, ER and EW denote the static values of external properties
    --  Async_Readers, Async_Writers, Effective_Reads and Effective_Writes. Item
-   --  is the related variable or state. Ensure the legality of the permutation
-   --  and if this is not the case, issue an error.
+   --  is the related variable or state. Ensure legality of the combination and
+   --  issue an error for an illegal combination.
 
    function Delay_Config_Pragma_Analyze (N : Node_Id) return Boolean;
    --  N is a pragma appearing in a configuration pragma file. Most such
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index e86ca31..c308ed7 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -4270,6 +4270,9 @@ package body Sem_Res is
                   null;
 
                else
+                  --  Error message should mention SPARK, and perhaps give
+                  --  a SPARK RM reference ???
+
                   Error_Msg_N
                     ("volatile object cannot act as actual in a call", A);
                end if;
@@ -5518,12 +5521,11 @@ package body Sem_Res is
         and then
           ((Is_Array_Type (Etype (Nam))
              and then Covers (Typ, Component_Type (Etype (Nam))))
-             or else (Is_Access_Type (Etype (Nam))
-                       and then Is_Array_Type (Designated_Type (Etype (Nam)))
-                       and then
-                         Covers
-                          (Typ,
-                           Component_Type (Designated_Type (Etype (Nam))))))
+           or else
+             (Is_Access_Type (Etype (Nam))
+               and then Is_Array_Type (Designated_Type (Etype (Nam)))
+               and then
+                 Covers (Typ, Component_Type (Designated_Type (Etype (Nam))))))
       then
          declare
             Index_Node : Node_Id;
@@ -6518,6 +6520,8 @@ package body Sem_Res is
             Par  := Parent (Par);
          end loop;
 
+         --  Message should mention SPARK, and perhaps SPARK RM ref ???
+
          if not Usage_OK then
             Error_Msg_N ("volatile object cannot appear in this context", N);
          end if;