par_sco.adb, [...]: Minor reformatting.

2012-07-30  Robert Dewar  <dewar@adacore.com>

	* par_sco.adb, a-cihama.adb, a-coinve.adb, exp_ch7.adb, a-ciorse.adb,
	exp_ch9.adb, sem_dim.adb, par-ch13.adb, sem_ch9.adb, a-cidlli.adb,
	a-cimutr.adb, freeze.adb, a-ciormu.adb, sem_res.adb, sem_attr.adb,
	a-cihase.adb, exp_ch4.adb, sem_ch4.adb, a-ciorma.adb,
	s-tasinf-linux.ads, sem_ch13.adb, a-coinho.adb: Minor reformatting.
	Add comments.

From-SVN: r189977

gcc/ada/ChangeLog

@@ -1,3 +1,12 @@
+2012-07-30  Robert Dewar  <dewar@adacore.com>
+
+	* par_sco.adb, a-cihama.adb, a-coinve.adb, exp_ch7.adb, a-ciorse.adb,
+	exp_ch9.adb, sem_dim.adb, par-ch13.adb, sem_ch9.adb, a-cidlli.adb,
+	a-cimutr.adb, freeze.adb, a-ciormu.adb, sem_res.adb, sem_attr.adb,
+	a-cihase.adb, exp_ch4.adb, sem_ch4.adb, a-ciorma.adb,
+	s-tasinf-linux.ads, sem_ch13.adb, a-coinho.adb: Minor reformatting.
+	Add comments.
+
 2012-07-30  Vincent Pucci  <pucci@adacore.com>
 
 	* sem_ch9.adb (Allows_Lock_Free_Implementation): Restrict implicit

gcc/ada/a-cidlli.adb

@@ -888,16 +888,19 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
       end if;
 
       declare
-         pragma Unsuppress (Accessibility_Check);
          --  The element allocator may need an accessibility check in the case
          --  the actual type is class-wide or has access discriminants (see
          --  RM 4.8(10.1) and AI12-0035). We don't unsuppress the check on the
          --  allocator in the loop below, because the one in this block would
          --  have failed already.
 
+         pragma Unsuppress (Accessibility_Check);
+
          Element : Element_Access := new Element_Type'(New_Item);
+
       begin
          New_Node := new Node_Type'(Element, null, null);
+
       exception
          when others =>
             Free (Element);
@@ -1468,12 +1471,14 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
       pragma Assert (Vet (Position), "bad cursor in Replace_Element");
 
       declare
-         pragma Unsuppress (Accessibility_Check);
          --  The element allocator may need an accessibility check in the case
          --  the actual type is class-wide or has access discriminants (see
          --  RM 4.8(10.1) and AI12-0035).
 
+         pragma Unsuppress (Accessibility_Check);
+
          X : Element_Access := Position.Node.Element;
+
       begin
          Position.Node.Element := new Element_Type'(New_Item);
          Free (X);

gcc/ada/a-cihama.adb

@@ -695,12 +695,15 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
          Position.Node.Key := new Key_Type'(Key);
 
          declare
-            pragma Unsuppress (Accessibility_Check);
             --  The element allocator may need an accessibility check in the
             --  case the actual type is class-wide or has access discriminants
             --  (see RM 4.8(10.1) and AI12-0035).
+
+            pragma Unsuppress (Accessibility_Check);
+
          begin
             Position.Node.Element := new Element_Type'(New_Item);
+
          exception
             when others =>
                Free_Key (K);
@@ -736,14 +739,16 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
          K  : Key_Access := new Key_Type'(Key);
          E  : Element_Access;
 
-         pragma Unsuppress (Accessibility_Check);
          --  The element allocator may need an accessibility check in the case
          --  the actual type is class-wide or has access discriminants (see
          --  RM 4.8(10.1) and AI12-0035).
 
+         pragma Unsuppress (Accessibility_Check);
+
       begin
          E := new Element_Type'(New_Item);
          return new Node_Type'(K, E, Next);
+
       exception
          when others =>
             Free_Key (K);
@@ -1177,12 +1182,15 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
       Node.Key := new Key_Type'(Key);
 
       declare
-         pragma Unsuppress (Accessibility_Check);
          --  The element allocator may need an accessibility check in the case
          --  the actual type is class-wide or has access discriminants (see
          --  RM 4.8(10.1) and AI12-0035).
+
+         pragma Unsuppress (Accessibility_Check);
+
       begin
          Node.Element := new Element_Type'(New_Item);
+
       exception
          when others =>
             Free_Key (K);
@@ -1230,10 +1238,12 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
       declare
          X : Element_Access := Position.Node.Element;
 
-         pragma Unsuppress (Accessibility_Check);
          --  The element allocator may need an accessibility check in the case
          --  the actual type is class-wide or has access discriminants (see
          --  RM 4.8(10.1) and AI12-0035).
+
+         pragma Unsuppress (Accessibility_Check);
+
       begin
          Position.Node.Element := new Element_Type'(New_Item);
          Free_Element (X);

gcc/ada/a-cihase.adb

@@ -186,10 +186,12 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
    procedure Assign (Node : Node_Access; Item : Element_Type) is
       X : Element_Access := Node.Element;
 
-      pragma Unsuppress (Accessibility_Check);
       --  The element allocator may need an accessibility check in the case the
       --  actual type is class-wide or has access discriminants (RM 4.8(10.1)
       --  and AI12-0035).
+
+      pragma Unsuppress (Accessibility_Check);
+
    begin
       Node.Element := new Element_Type'(Item);
       Free_Element (X);
@@ -199,10 +201,10 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
    begin
       if Target'Address = Source'Address then
          return;
+      else
+         Target.Clear;
+         Target.Union (Source);
       end if;
-
-      Target.Clear;
-      Target.Union (Source);
    end Assign;
 
    --------------
@@ -813,10 +815,12 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
          X := Position.Node.Element;
 
          declare
-            pragma Unsuppress (Accessibility_Check);
             --  The element allocator may need an accessibility check in the
             --  case the actual type is class-wide or has access discriminants
             --  (see RM 4.8(10.1) and AI12-0035).
+
+            pragma Unsuppress (Accessibility_Check);
+
          begin
             Position.Node.Element := new Element_Type'(New_Item);
          end;
@@ -875,14 +879,18 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
       --------------
 
       function New_Node (Next : Node_Access) return Node_Access is
-         pragma Unsuppress (Accessibility_Check);
+
          --  The element allocator may need an accessibility check in the case
          --  the actual type is class-wide or has access discriminants (see
          --  RM 4.8(10.1) and AI12-0035).
 
+         pragma Unsuppress (Accessibility_Check);
+
          Element : Element_Access := new Element_Type'(New_Item);
+
       begin
          return new Node_Type'(Element, Next);
+
       exception
          when others =>
             Free_Element (Element);
@@ -898,9 +906,7 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
 
       Local_Insert (HT, New_Item, Node, Inserted);
 
-      if Inserted
+      if Inserted and then HT.Length > HT_Ops.Capacity (HT) then
-        and then HT.Length > HT_Ops.Capacity (HT)
-      then
          HT_Ops.Reserve_Capacity (HT, HT.Length);
       end if;
    end Insert;
@@ -1335,10 +1341,12 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
       X := Node.Element;
 
       declare
-         pragma Unsuppress (Accessibility_Check);
          --  The element allocator may need an accessibility check in the case
          --  the actual type is class-wide or has access discriminants (see
          --  RM 4.8(10.1) and AI12-0035).
+
+         pragma Unsuppress (Accessibility_Check);
+
       begin
          Node.Element := new Element_Type'(New_Item);
       end;

gcc/ada/a-cimutr.adb

@@ -292,12 +292,14 @@ package body Ada.Containers.Indefinite_Multiway_Trees is
       end if;
 
       declare
-         pragma Unsuppress (Accessibility_Check);
          --  The element allocator may need an accessibility check in the case
          --  the actual type is class-wide or has access discriminants (see
          --  RM 4.8(10.1) and AI12-0035). We don't unsuppress the check on the
          --  allocator in the loop below, because the one in this block would
          --  have failed already.
+
+         pragma Unsuppress (Accessibility_Check);
+
       begin
          Element := new Element_Type'(New_Item);
       end;
@@ -1251,12 +1253,14 @@ package body Ada.Containers.Indefinite_Multiway_Trees is
       Position.Container := Parent.Container;
 
       declare
-         pragma Unsuppress (Accessibility_Check);
          --  The element allocator may need an accessibility check in the case
          --  the actual type is class-wide or has access discriminants (see
          --  RM 4.8(10.1) and AI12-0035). We don't unsuppress the check on the
          --  allocator in the loop below, because the one in this block would
          --  have failed already.
+
+         pragma Unsuppress (Accessibility_Check);
+
       begin
          Element := new Element_Type'(New_Item);
       end;
@@ -1826,12 +1830,14 @@ package body Ada.Containers.Indefinite_Multiway_Trees is
       end if;
 
       declare
-         pragma Unsuppress (Accessibility_Check);
          --  The element allocator may need an accessibility check in the case
          --  the actual type is class-wide or has access discriminants (see
          --  RM 4.8(10.1) and AI12-0035). We don't unsuppress the check on the
          --  allocator in the loop below, because the one in this block would
          --  have failed already.
+
+         pragma Unsuppress (Accessibility_Check);
+
       begin
          Element := new Element_Type'(New_Item);
       end;
@@ -2194,10 +2200,12 @@ package body Ada.Containers.Indefinite_Multiway_Trees is
       end if;
 
       declare
-         pragma Unsuppress (Accessibility_Check);
          --  The element allocator may need an accessibility check in the case
          --  the actual type is class-wide or has access discriminants (see
          --  RM 4.8(10.1) and AI12-0035).
+
+         pragma Unsuppress (Accessibility_Check);
+
       begin
          E := new Element_Type'(New_Item);
       end;

gcc/ada/a-ciorma.adb

@@ -813,12 +813,15 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
          Position.Node.Key := new Key_Type'(Key);
 
          declare
-            pragma Unsuppress (Accessibility_Check);
             --  The element allocator may need an accessibility check in the
             --  case the actual type is class-wide or has access discriminants
             --  (see RM 4.8(10.1) and AI12-0035).
+
+            pragma Unsuppress (Accessibility_Check);
+
          begin
             Position.Node.Element := new Element_Type'(New_Item);
+
          exception
             when others =>
                Free_Key (K);
@@ -857,10 +860,12 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
       function New_Node return Node_Access is
          Node : Node_Access := new Node_Type;
 
-         pragma Unsuppress (Accessibility_Check);
          --  The element allocator may need an accessibility check in the case
          --  the actual type is class-wide or has access discriminants (see
          --  RM 4.8(10.1) and AI12-0035).
+
+         pragma Unsuppress (Accessibility_Check);
+
       begin
          Node.Key := new Key_Type'(Key);
          Node.Element := new Element_Type'(New_Item);
@@ -869,9 +874,10 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
       exception
          when others =>
 
-            --  On exception, deallocate key and elem
+            --  On exception, deallocate key and elem. Note that free
+            --  deallocates both the key and the elem.
 
-            Free (Node);  --  Note that Free deallocates key and elem too
+            Free (Node);
             raise;
       end New_Node;
 
@@ -1502,12 +1508,15 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
       Node.Key := new Key_Type'(Key);
 
       declare
-         pragma Unsuppress (Accessibility_Check);
          --  The element allocator may need an accessibility check in the case
          --  the actual type is class-wide or has access discriminants (see
          --  RM 4.8(10.1) and AI12-0035).
+
+         pragma Unsuppress (Accessibility_Check);
+
       begin
          Node.Element := new Element_Type'(New_Item);
+
       exception
          when others =>
             Free_Key (K);
@@ -1556,10 +1565,12 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
       declare
          X : Element_Access := Position.Node.Element;
 
-         pragma Unsuppress (Accessibility_Check);
          --  The element allocator may need an accessibility check in the case
          --  the actual type is class-wide or has access discriminants (see
          --  RM 4.8(10.1) and AI12-0035).
+
+         pragma Unsuppress (Accessibility_Check);
+
       begin
          Position.Node.Element := new Element_Type'(New_Item);
          Free_Element (X);

gcc/ada/a-ciormu.adb

@@ -1167,11 +1167,12 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
       --------------
 
       function New_Node return Node_Access is
-         pragma Unsuppress (Accessibility_Check);
          --  The element allocator may need an accessibility check in the case
          --  the actual type is class-wide or has access discriminants (see
          --  RM 4.8(10.1) and AI12-0035).
 
+         pragma Unsuppress (Accessibility_Check);
+
          Element : Element_Access := new Element_Type'(New_Item);
 
       begin
@@ -1180,6 +1181,7 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
                                Right   => null,
                                Color   => Red_Black_Trees.Red,
                                Element => Element);
+
       exception
          when others =>
             Free_Element (Element);
@@ -1774,10 +1776,12 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
          declare
             X : Element_Access := Node.Element;
 
-            pragma Unsuppress (Accessibility_Check);
             --  The element allocator may need an accessibility check in the
             --  case the actual type is class-wide or has access discriminants
             --  (see RM 4.8(10.1) and AI12-0035).
+
+            pragma Unsuppress (Accessibility_Check);
+
          begin
             Node.Element := new Element_Type'(Item);
             Free_Element (X);
@@ -1803,10 +1807,13 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
          --------------
 
          function New_Node return Node_Access is
-            pragma Unsuppress (Accessibility_Check);
+
             --  The element allocator may need an accessibility check in the
             --  case the actual type is class-wide or has access discriminants
             --  (see RM 4.8(10.1) and AI12-0035).
+
+            pragma Unsuppress (Accessibility_Check);
+
          begin
             Node.Element := new Element_Type'(Item);  -- OK if fails
             Node.Color := Red_Black_Trees.Red;

gcc/ada/a-ciorse.adb

@@ -1174,10 +1174,12 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
          end if;
 
          declare
-            pragma Unsuppress (Accessibility_Check);
             --  The element allocator may need an accessibility check in the
             --  case the actual type is class-wide or has access discriminants
             --  (see RM 4.8(10.1) and AI12-0035).
+
+            pragma Unsuppress (Accessibility_Check);
+
          begin
             X := Position.Node.Element;
             Position.Node.Element := new Element_Type'(New_Item);
@@ -1245,11 +1247,12 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
       --------------
 
       function New_Node return Node_Access is
-         pragma Unsuppress (Accessibility_Check);
          --  The element allocator may need an accessibility check in the case
          --  the actual type is class-wide or has access discriminants (see
          --  RM 4.8(10.1) and AI12-0035).
 
+         pragma Unsuppress (Accessibility_Check);
+
          Element : Element_Access := new Element_Type'(New_Item);
 
       begin
@@ -1258,6 +1261,7 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
                                Right   => null,
                                Color   => Red_Black_Trees.Red,
                                Element => Element);
+
       exception
          when others =>
             Free_Element (Element);
@@ -1831,10 +1835,12 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
       end if;
 
       declare
-         pragma Unsuppress (Accessibility_Check);
          --  The element allocator may need an accessibility check in the case
          --  the actual type is class-wide or has access discriminants (see
          --  RM 4.8(10.1) and AI12-0035).
+
+         pragma Unsuppress (Accessibility_Check);
+
       begin
          X := Node.Element;
          Node.Element := new Element_Type'(New_Item);
@@ -1873,10 +1879,13 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
       --------------
 
       function New_Node return Node_Access is
-         pragma Unsuppress (Accessibility_Check);
+
          --  The element allocator may need an accessibility check in the case
          --  the actual type is class-wide or has access discriminants (see
          --  RM 4.8(10.1) and AI12-0035).
+
+         pragma Unsuppress (Accessibility_Check);
+
       begin
          Node.Element := new Element_Type'(Item);  -- OK if fails
          Node.Color := Red;
@@ -1895,9 +1904,7 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
       --  Start of processing for Replace_Element
 
    begin
-      if Item < Node.Element.all
+      if Item < Node.Element.all or else Node.Element.all < Item then
-        or else Node.Element.all < Item
-      then
          null;
 
       else
@@ -1907,10 +1914,12 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
          end if;
 
          declare
-            pragma Unsuppress (Accessibility_Check);
             --  The element allocator may need an accessibility check in the
             --  case the actual type is class-wide or has access discriminants
             --  (see RM 4.8(10.1) and AI12-0035).
+
+            pragma Unsuppress (Accessibility_Check);
+
          begin
             Node.Element := new Element_Type'(Item);
             Free_Element (X);
@@ -1932,10 +1941,12 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
             end if;
 
             declare
-               pragma Unsuppress (Accessibility_Check);
                --  The element allocator may need an accessibility check in the
                --  case actual type is class-wide or has access discriminants
                --  (see RM 4.8(10.1) and AI12-0035).
+
+               pragma Unsuppress (Accessibility_Check);
+
             begin
                Node.Element := new Element_Type'(Item);
                Free_Element (X);

gcc/ada/a-coinho.adb

@@ -223,10 +223,12 @@ package body Ada.Containers.Indefinite_Holders is
       declare
          X : Element_Access := Container.Element;
 
-         pragma Unsuppress (Accessibility_Check);
          --  Element allocator may need an accessibility check in case actual
          --  type is class-wide or has access discriminants (RM 4.8(10.1) and
          --  AI12-0035).
+
+         pragma Unsuppress (Accessibility_Check);
+
       begin
          Container.Element := new Element_Type'(New_Item);
          Free (X);
@@ -238,10 +240,12 @@ package body Ada.Containers.Indefinite_Holders is
    ---------------
 
    function To_Holder (New_Item : Element_Type) return Holder is
-      pragma Unsuppress (Accessibility_Check);
       --  The element allocator may need an accessibility check in the case the
       --  actual type is class-wide or has access discriminants (RM 4.8(10.1)
       --  and AI12-0035).
+
+      pragma Unsuppress (Accessibility_Check);
+
    begin
       return (AF.Controlled with new Element_Type'(New_Item), 0);
    end To_Holder;

gcc/ada/a-coinve.adb

@@ -1699,10 +1699,12 @@ package body Ada.Containers.Indefinite_Vectors is
             --  storage available, or because element initialization fails).
 
             declare
-               pragma Unsuppress (Accessibility_Check);
                --  The element allocator may need an accessibility check in the
                --  case actual type is class-wide or has access discriminants
                --  (see RM 4.8(10.1) and AI12-0035).
+
+               pragma Unsuppress (Accessibility_Check);
+
             begin
                Container.Elements.EA (Idx) := new Element_Type'(New_Item);
             end;
@@ -1752,10 +1754,12 @@ package body Ada.Containers.Indefinite_Vectors is
                   --  initialization fails).
 
                   declare
-                     pragma Unsuppress (Accessibility_Check);
                      --  The element allocator may need an accessibility check
                      --  in case the actual type is class-wide or has access
                      --  discriminants (see RM 4.8(10.1) and AI12-0035).
+
+                     pragma Unsuppress (Accessibility_Check);
+
                   begin
                      E (Idx) := new Element_Type'(New_Item);
                   end;
@@ -1794,11 +1798,14 @@ package body Ada.Containers.Indefinite_Vectors is
                --  K always has a value if the exception handler triggers.
 
                K := Before;
+
                declare
-                  pragma Unsuppress (Accessibility_Check);
                   --  The element allocator may need an accessibility check in
                   --  the case the actual type is class-wide or has access
                   --  discriminants (see RM 4.8(10.1) and AI12-0035).
+
+                  pragma Unsuppress (Accessibility_Check);
+
                begin
                   while K < Index loop
                      E (K) := new Element_Type'(New_Item);
@@ -1905,10 +1912,12 @@ package body Ada.Containers.Indefinite_Vectors is
                --  initialization fails).
 
                declare
-                  pragma Unsuppress (Accessibility_Check);
                   --  The element allocator may need an accessibility check in
                   --  the case the actual type is class-wide or has access
                   --  discriminants (see RM 4.8(10.1) and AI12-0035).
+
+                  pragma Unsuppress (Accessibility_Check);
+
                begin
                   Dst.EA (Idx) := new Element_Type'(New_Item);
                end;
@@ -1952,10 +1961,12 @@ package body Ada.Containers.Indefinite_Vectors is
                --  let it propagate.
 
                declare
-                  pragma Unsuppress (Accessibility_Check);
                   --  The element allocator may need an accessibility check in
                   --  the case the actual type is class-wide or has access
                   --  discriminants (see RM 4.8(10.1) and AI12-0035).
+
+                  pragma Unsuppress (Accessibility_Check);
+
                begin
                   Dst.EA (Idx) := new Element_Type'(New_Item);
                end;
@@ -3208,10 +3219,12 @@ package body Ada.Containers.Indefinite_Vectors is
       declare
          X : Element_Access := Container.Elements.EA (Index);
 
-         pragma Unsuppress (Accessibility_Check);
          --  The element allocator may need an accessibility check in the case
          --  where the actual type is class-wide or has access discriminants
          --  (see RM 4.8(10.1) and AI12-0035).
+
+         pragma Unsuppress (Accessibility_Check);
+
       begin
          Container.Elements.EA (Index) := new Element_Type'(New_Item);
          Free (X);
@@ -3244,10 +3257,12 @@ package body Ada.Containers.Indefinite_Vectors is
       declare
          X : Element_Access := Container.Elements.EA (Position.Index);
 
-         pragma Unsuppress (Accessibility_Check);
          --  The element allocator may need an accessibility check in the case
          --  where the actual type is class-wide or has access discriminants
          --  (see RM 4.8(10.1) and AI12-0035).
+
+         pragma Unsuppress (Accessibility_Check);
+
       begin
          Container.Elements.EA (Position.Index) := new Element_Type'(New_Item);
          Free (X);
@@ -3993,10 +4008,12 @@ package body Ada.Containers.Indefinite_Vectors is
       Last := Index_Type'First;
 
       declare
-         pragma Unsuppress (Accessibility_Check);
          --  The element allocator may need an accessibility check in the case
          --  where the actual type is class-wide or has access discriminants
          --  (see RM 4.8(10.1) and AI12-0035).
+
+         pragma Unsuppress (Accessibility_Check);
+
       begin
          loop
             Elements.EA (Last) := new Element_Type'(New_Item);

gcc/ada/exp_ch4.adb

@@ -705,8 +705,7 @@ package body Exp_Ch4 is
                or else
                  (Is_Class_Wide_Type (Etype (Exp))
                    and then Scope (PtrT) /= Current_Scope))
-           and then
+           and then (Tagged_Type_Expansion or else VM_Target /= No_VM)
-             (Tagged_Type_Expansion or else VM_Target /= No_VM)
          then
             --  If the allocator was built in place, Ref is already a reference
             --  to the access object initialized to the result of the allocator

gcc/ada/exp_ch7.adb

@@ -4568,6 +4568,9 @@ package body Exp_Ch7 is
                --  finalization blocks, and we put everything into a wrapper
                --  block to clearly expose the construct to the back-end.
 
+               --  This requirement for "clearly expose" must be properly
+               --  documented in sinfo/einfo ???
+
                if Present (Prev_Fin) then
                   Insert_Before_And_Analyze (Prev_Fin, Fin_Block);
                else

gcc/ada/exp_ch9.adb

@@ -5485,6 +5485,7 @@ package body Exp_Ch9 is
 
    procedure Ensure_Statement_Present (Loc : Source_Ptr; Alt : Node_Id) is
       Stmt : Node_Id;
+
    begin
       if Opt.Suppress_Control_Flow_Optimizations
         and then Is_Empty_List (Statements (Alt))
@@ -5494,6 +5495,9 @@ package body Exp_Ch9 is
          --  Mark NULL statement as coming from source so that it is not
          --  eliminated by GIGI.
 
+         --  Another covert channel! If this is a requirement, it must be
+         --  documented in sinfo/einfo ???
+
          Set_Comes_From_Source (Stmt, True);
 
          Set_Statements (Alt, New_List (Stmt));

gcc/ada/freeze.adb

@@ -3029,7 +3029,7 @@ package body Freeze is
 
                --  Pre/post conditions are implemented through a subprogram in
                --  the corresponding body, and therefore are not checked on an
-               --  imported subprogram, for which the body is not available.
+               --  imported subprogram for which the body is not available.
 
                --  Could consider generating a wrapper to take care of this???
 

gcc/ada/par-ch13.adb

@@ -645,7 +645,6 @@ package body Ch13 is
       Ptr     : Source_Ptr;
 
    begin
-
       --  Aspect Specification is present
 
       Ptr := Token_Ptr;
@@ -834,11 +833,10 @@ package body Ch13 is
       --  Otherwise we have an illegal range attribute. Note that P_Name
       --  ensures that Token = Tok_Range is the only possibility left here.
 
-      else -- Token = Tok_Range
+      else
          Error_Msg_SC ("RANGE attribute illegal here!");
          raise Error_Resync;
       end if;
-
    end P_Code_Statement;
 
 end Ch13;

gcc/ada/par_sco.adb

@@ -492,13 +492,16 @@ package body Par_SCO is
 
                --  For entry guard, the token sloc is from the N_Entry_Body.
                --  For PRAGMA, we must get the location from the pragma node.
-               --  Argument N is the pragma argument, and we have to go up two
+               --  Argument N is the pragma argument, and we have to go up
-               --  levels (through the pragma argument association) to get to
+               --  two levels (through the pragma argument association) to
-               --  the pragma node itself. For the guard on a select
+               --  get to the pragma node itself. For the guard on a select
-               --  alternative, we do not have access to the token location
+               --  alternative, we do not have access to the token location for
-               --  for the WHEN, so we use the first sloc of the condition
+               --  the WHEN, so we use the first sloc of the condition itself
-               --  itself (note: we use First_Sloc, not Sloc, because this is
+               --  (note: we use First_Sloc, not Sloc, because this is what is
-               --  what is referenced by dominance markers).
+               --  referenced by dominance markers).
+
+               --  Doesn't this requirement of using First_Sloc need to be
+               --  documented in the spec ???
 
                if Nkind_In (Parent (N), N_Accept_Alternative,
                                         N_Delay_Alternative,

gcc/ada/s-tasinf-linux.ads

@@ -48,10 +48,10 @@ package System.Task_Info is
    pragma Elaborate_Body;
    --  To ensure that a body is allowed
 
-   --  Linux provides a way to define the ideal processor to use for a given
+   --  The Linux kernel provides a way to define the ideal processor to use for
-   --  thread. The ideal processor is not necessarily the one that will be used
+   --  a given thread. The ideal processor is not necessarily the one that will
-   --  by the OS but the OS will always try to schedule this thread to the
+   --  be used by the OS but the OS will always try to schedule this thread to
-   --  specified processor if it is available.
+   --  the specified processor if it is available.
 
    --  The Task_Info pragma:
 

gcc/ada/sem_attr.adb

@@ -4029,10 +4029,10 @@ package body Sem_Attr is
          --  within the subprogram itself. If the prefix includes a function
          --  call it may involve finalization actions that should only be
          --  inserted when the attribute has been rewritten as a declarations.
-         --  As a result, if the prefix is not a simple name we create a
+         --  As a result, if the prefix is not a simple name we create
-         --  declaration for it now,  and insert it at the start of the
+         --  a declaration for it now, and insert it at the start of the
-         --  enclosing subprogram. This is properly an expansion activity but
+         --  enclosing subprogram. This is properly an expansion activity
-         --  it has to be performed now to prevent out-of-order issues.
+         --  but it has to be performed now to prevent out-of-order issues.
 
          if not Is_Entity_Name (P) then
             P_Type := Base_Type (P_Type);
@@ -4474,9 +4474,9 @@ package body Sem_Attr is
          Check_Decimal_Fixed_Point_Type;
          Set_Etype (N, P_Base_Type);
 
-         --  Because the context is universal_real (3.5.10(12)) it is a legal
+         --  Because the context is universal_real (3.5.10(12)) it is a
-         --  context for a universal fixed expression. This is the only
+         --  legal context for a universal fixed expression. This is the
-         --  attribute whose functional description involves U_R.
+         --  only attribute whose functional description involves U_R.
 
          if Etype (E1) = Universal_Fixed then
             declare
@@ -4771,8 +4771,8 @@ package body Sem_Attr is
 
                Validate_Remote_Access_To_Class_Wide_Type (N);
 
-            --  The prefix is allowed to be an implicit dereference
+            --  The prefix is allowed to be an implicit dereference of an
-            --  of an access value designating a task.
+            --  access value designating a task.
 
             else
                Check_Task_Prefix;

gcc/ada/sem_ch13.adb

@@ -1866,8 +1866,8 @@ package body Sem_Ch13 is
           Chars => Name_Address,
           Expression => Expression (N)));
 
-      --  We preserve Comes_From_Source, since logically the clause still
+      --  We preserve Comes_From_Source, since logically the clause still comes
-      --  comes from the source program even though it is changed in form.
+      --  from the source program even though it is changed in form.
 
       Set_Comes_From_Source (N, CS);
 
@@ -2685,8 +2685,8 @@ package body Sem_Ch13 is
 
                   --  Legality checks on the address clause for initialized
                   --  objects is deferred until the freeze point, because
-                  --  a subsequent pragma might indicate that the object is
+                  --  a subsequent pragma might indicate that the object
-                  --  imported and thus not initialized.
+                  --  is imported and thus not initialized.
 
                   Set_Has_Delayed_Freeze (U_Ent);
 
@@ -3120,8 +3120,8 @@ package body Sem_Ch13 is
 
          when Attribute_Implicit_Dereference =>
 
-            --  Legality checks already performed at the point of
+            --  Legality checks already performed at the point of the type
-            --  the type declaration, aspect is not delayed.
+            --  declaration, aspect is not delayed.
 
             null;
 

gcc/ada/sem_ch4.adb

@@ -4231,8 +4231,9 @@ package body Sem_Ch4 is
 
                begin
                   Set_Parent (Par, Parent (Parent (N)));
+
                   if Try_Object_Operation
-                    (Sinfo.Name (Par), CW_Test_Only => True)
+                       (Sinfo.Name (Par), CW_Test_Only => True)
                   then
                      return;
                   end if;
@@ -6531,7 +6532,6 @@ package body Sem_Ch4 is
 
       declare
          Arg : Node_Id;
-
       begin
          Arg := First (Exprs);
          while Present (Arg) loop
@@ -6542,9 +6542,10 @@ package body Sem_Ch4 is
 
       if not Is_Overloaded (Func_Name) then
          Func := Entity (Func_Name);
-         Indexing := Make_Function_Call (Loc,
+         Indexing :=
-           Name => New_Occurrence_Of (Func, Loc),
+           Make_Function_Call (Loc,
-           Parameter_Associations => Assoc);
+             Name                   => New_Occurrence_Of (Func, Loc),
+             Parameter_Associations => Assoc);
          Rewrite (N, Indexing);
          Analyze (N);
 
@@ -6609,8 +6610,8 @@ package body Sem_Ch4 is
       end if;
 
       if Etype (N) = Any_Type then
-         Error_Msg_NE ("container cannot be indexed with&",
+         Error_Msg_NE
-           N, Etype (First (Exprs)));
+           ("container cannot be indexed with&", N, Etype (First (Exprs)));
          Rewrite (N, New_Occurrence_Of (Any_Id, Loc));
       else
          Analyze (N);

gcc/ada/sem_ch9.adb

@@ -68,7 +68,7 @@ package body Sem_Ch9 is
    -----------------------
 
    function Allows_Lock_Free_Implementation
-     (N        : Node_Id;
+     (N               : Node_Id;
       Lock_Free_Given : Boolean := False) return Boolean;
    --  This routine returns True iff N satisfies the following list of lock-
    --  free restrictions for protected type declaration and protected body:
@@ -130,9 +130,8 @@ package body Sem_Ch9 is
       --  when Lock_Free_Given is True.
 
    begin
-      pragma Assert (Nkind_In (N,
+      pragma Assert (Nkind_In (N, N_Protected_Type_Declaration,
-                               N_Protected_Type_Declaration,
+                                  N_Protected_Body));
-                               N_Protected_Body));
 
       --  The lock-free implementation is currently enabled through a debug
       --  flag. When Lock_Free_Given is True, an aspect Lock_Free forces the
@@ -418,8 +417,8 @@ package body Sem_Ch9 is
                                  and then Is_Access_Type (Etype (Prefix (N))))
                      then
                         if Lock_Free_Given then
-                           Error_Msg_N ("dereference of access value " &
+                           Error_Msg_N
-                                        "not allowed", N);
+                             ("dereference of access value not allowed", N);
                            return Skip;
                         end if;
 
@@ -431,8 +430,8 @@ package body Sem_Ch9 is
                        and then not Is_Static_Expression (N)
                      then
                         if Lock_Free_Given then
-                           Error_Msg_N ("non-static function call not allowed",
+                           Error_Msg_N
-                                        N);
+                             ("non-static function call not allowed", N);
                            return Skip;
                         end if;
 
@@ -463,10 +462,12 @@ package body Sem_Ch9 is
                            --  outside the protected subprogram scope.
 
                            if Ekind (Id) in Assignable_Kind
-                             and then not Scope_Within_Or_Same (Scope (Id),
+                             and then not
-                                            Sub_Id)
+                               Scope_Within_Or_Same (Scope (Id), Sub_Id)
-                             and then not Scope_Within_Or_Same (Scope (Id),
+                             and then not
-                                            Protected_Body_Subprogram (Sub_Id))
+                               Scope_Within_Or_Same
+                                 (Scope (Id),
+                                  Protected_Body_Subprogram (Sub_Id))
                            then
                               if Lock_Free_Given then
                                  Error_Msg_NE
@@ -647,7 +648,6 @@ package body Sem_Ch9 is
                  and then (not Lock_Free_Given
                             or else Errors_Count = Serious_Errors_Detected)
                then
-
                   --  Establish a relation between the subprogram body and the
                   --  unique protected component it references.
 

gcc/ada/sem_dim.adb

@@ -1712,9 +1712,7 @@ package body Sem_Dim is
             --  entity when the object is a constant whose type is a
             --  dimensioned type.
 
-            if Constant_Present (N)
+            if Constant_Present (N) and then not Exists (Dim_Of_Etyp) then
-              and then not Exists (Dim_Of_Etyp)
-            then
                Set_Dimensions (Id, Dim_Of_Expr);
 
             --  Otherwise, issue an error message

gcc/ada/sem_res.adb

@@ -7129,9 +7129,9 @@ package body Sem_Res is
             return;
          end if;
 
-      else
+      --  If not overloaded, resolve P with its own type
-         --  If not overloaded, resolve P with its own type
 
+      else
          Resolve (P);
       end if;