[multiple changes]

2013-04-12  Robert Dewar  <dewar@adacore.com>

	* checks.adb, sem_elab.adb, repinfo.adb, sem_ch4.adb, restrict.adb,
	restrict.ads: Minor reformatting.

2013-04-12  Ed Schonberg  <schonberg@adacore.com>

	* lib-xref.adb: Retrieve original name of classwide type if any.

2013-04-12  Thomas Quinot  <quinot@adacore.com>

	* exp_ch11.ads: Minor reformatting.

From-SVN: r197910

gcc/ada/ChangeLog

+2013-04-12  Robert Dewar  <dewar@adacore.com>
+
+	* checks.adb, sem_elab.adb, repinfo.adb, sem_ch4.adb, restrict.adb,
+	restrict.ads: Minor reformatting.
+
+2013-04-12  Ed Schonberg  <schonberg@adacore.com>
+
+	* lib-xref.adb: Retrieve original name of classwide type if any.
+
+2013-04-12  Thomas Quinot  <quinot@adacore.com>
+
+	* exp_ch11.ads: Minor reformatting.
+
 2013-04-12  Hristian Kirtchev  <kirtchev@adacore.com>
 
 	* aspects.adb: Alphabetize subprogram bodies in this unit. Add

gcc/ada/checks.adb

@@ -6242,9 +6242,9 @@ package body Checks is
          return;
       end if;
 
-      --  Do not insert checks within a predicate function.  This will arise
-      --  if the current unit and the predicate function are  being compiled
-      --  with  validity checks enabled.
+      --  Do not insert checks within a predicate function. This will arise
+      --  if the current unit and the predicate function are being compiled
+      --  with validity checks enabled.
 
       if Present (Predicate_Function (Typ))
         and then Current_Scope = Predicate_Function (Typ)

gcc/ada/exp_ch11.ads

@@ -96,4 +96,5 @@ package Exp_Ch11 is
    --  handler (and restriction No_Exception_Propagation is set), or if there
    --  is a local handler marking that it has a local raise. E is the entity
    --  of the corresponding exception.
+
 end Exp_Ch11;

gcc/ada/lib-xref.adb

@@ -1364,6 +1364,23 @@ package body Lib.Xref is
             then
                Tref := Etype (Tref);
 
+               --  Another special case: an object of a classwide type
+               --  initialized with a tag-indeterminate call gets a subtype
+               --  of the classwide type during expansion. See if the original
+               --  type in the declaration is named, and return it instead
+               --  of going to the root type.
+
+               if Ekind (Tref) = E_Class_Wide_Subtype
+                 and then Nkind (Parent (Ent)) = N_Object_Declaration
+                 and then
+                   Nkind (Original_Node (Object_Definition (Parent (Ent))))
+                     = N_Identifier
+               then
+                  Tref :=
+                    Entity
+                      (Original_Node ((Object_Definition (Parent (Ent)))));
+               end if;
+
             --  For anything else, exit
 
             else

gcc/ada/repinfo.adb

@@ -1041,11 +1041,13 @@ package body Repinfo is
          Write_Str ("for ");
          List_Name (Ent);
          Write_Str ("'" & Attr_Name & " use System.");
+
          if Bytes_Big_Endian xor Reverse_Storage_Order (Ent) then
             Write_Str ("High");
          else
             Write_Str ("Low");
          end if;
+
          Write_Line ("_Order_First;");
       end List_Attr;
 
@@ -1060,6 +1062,7 @@ package body Repinfo is
          if Is_Record_Type (Ent) then
             List_Attr ("Bit_Order");
          end if;
+
          List_Attr ("Scalar_Storage_Order");
       end if;
    end List_Scalar_Storage_Order;

gcc/ada/restrict.adb

@@ -69,22 +69,22 @@ package body Restrict is
    --  Once set True, this is never turned off again.
 
    No_Use_Of_Attribute : array (Attribute_Id) of Source_Ptr :=
-                          (others => No_Location);
+                           (others => No_Location);
 
    No_Use_Of_Attribute_Warning : array (Attribute_Id) of Boolean :=
-                                  (others => False);
+                                   (others => False);
 
    No_Use_Of_Attribute_Set : Boolean := False;
-   --  Indicates that No_Use_Of_Attribute was set at least once.
+   --  Indicates that No_Use_Of_Attribute was set at least once
 
    No_Use_Of_Pragma : array (Pragma_Id) of Source_Ptr :=
                         (others => No_Location);
 
    No_Use_Of_Pragma_Warning : array (Pragma_Id) of Boolean :=
-                                  (others => False);
+                                (others => False);
 
    No_Use_Of_Pragma_Set : Boolean := False;
-   --  Indicates that No_Use_Of_Pragma was set at least once.
+   --  Indicates that No_Use_Of_Pragma was set at least once
 
    -----------------------
    -- Local Subprograms --
@@ -322,7 +322,7 @@ package body Restrict is
          return;
       end if;
 
-      --  If nothing set, nothing to check.
+      --  If nothing set, nothing to check
 
       if not No_Use_Of_Attribute_Set then
          return;
@@ -334,8 +334,7 @@ package body Restrict is
          Error_Msg_Node_1 := N;
          Error_Msg_Warn := No_Use_Of_Attribute_Warning (A_Id);
          Error_Msg_N
-           ("<violation of restriction `No_Use_Of_Attribute '='> &`#",
-            N);
+           ("<violation of restriction `No_Use_Of_Attribute '='> &`#", N);
       end if;
    end Check_Restriction_No_Use_Of_Attribute;
 
@@ -356,7 +355,7 @@ package body Restrict is
          return;
       end if;
 
-      --  If nothing set, nothing to check.
+      --  If nothing set, nothing to check
 
       if not No_Use_Of_Pragma_Set then
          return;
@@ -368,8 +367,7 @@ package body Restrict is
          Error_Msg_Node_1 := Id;
          Error_Msg_Warn := No_Use_Of_Pragma_Warning (P_Id);
          Error_Msg_N
-           ("<violation of restriction `No_Use_Of_Pragma '='> &`#",
-            Id);
+           ("<violation of restriction `No_Use_Of_Pragma '='> &`#", Id);
       end if;
    end Check_Restriction_No_Use_Of_Pragma;
 
@@ -381,6 +379,10 @@ package body Restrict is
       function Chars_Is (E : Entity_Id; S : String) return Boolean;
       --  Return True iff Chars (E) matches S (given in lower case)
 
+      --------------
+      -- Chars_Is --
+      --------------
+
       function Chars_Is (E : Entity_Id; S : String) return Boolean is
          Nam : constant Name_Id := Chars (E);
       begin

gcc/ada/restrict.ads

@@ -253,12 +253,12 @@ package Restrict is
    --  being ignored here.
 
    procedure Check_Restriction_No_Use_Of_Attribute (N : Node_Id);
-   --  N is the node of an attribute definition clause.  An error message
+   --  N is the node of an attribute definition clause. An error message
    --  (warning) will be issued if a restriction (warning) was previously set
    --  for this attribute using Set_No_Use_Of_Attribute.
 
-   procedure Check_Restriction_No_Use_Of_Pragma  (N : Node_Id);
-   --  N is the node of a pragma.  An error message (warning) will be issued
+   procedure Check_Restriction_No_Use_Of_Pragma (N : Node_Id);
+   --  N is the node of a pragma. An error message (warning) will be issued
    --  if a restriction (warning) was previously set for this pragma using
    --  Set_No_Use_Of_Pragma.
 

gcc/ada/sem_ch4.adb

@@ -414,8 +414,7 @@ package body Sem_Ch4 is
          Check_Restriction (No_Allocators, N);
 
          --  Processing for No_Standard_Allocators_After_Elaboration, loop to
-         --  look at enclosing context, checking task case and main subprogram
-         --  case.
+         --  look at enclosing context, checking task/main subprogram case.
 
          C := N;
          P := Parent (C);

gcc/ada/sem_elab.adb

@@ -3339,14 +3339,11 @@ package body Sem_Elab is
             if Nkind (Item) = N_Pragma
               and then Pragma_Name (Item) = Name_Elaborate_All
             then
-               --  Return if some previous error on the pragma itself
-               --  The pragma may be unanalyzed, because of a previous error,
-               --  or if it is the context of a subunit, inherited by its
-               --  parent.
+               --  Return if some previous error on the pragma itself. The
+               --  pragma may be unanalyzed, because of a previous error, or
+               --  if it is the context of a subunit, inherited by its parent.
 
-               if Error_Posted (Item)
-                 or else not Analyzed (Item)
-               then
+               if Error_Posted (Item) or else not Analyzed (Item) then
                   return;
                end if;