[multiple changes]
authorArnaud Charlet <charlet@gcc.gnu.org>
Wed, 3 Aug 2011 14:52:04 +0000 (16:52 +0200)
committerArnaud Charlet <charlet@gcc.gnu.org>
Wed, 3 Aug 2011 14:52:04 +0000 (16:52 +0200)
2011-08-03  Robert Dewar  <dewar@adacore.com>

* a-cfdlli.adb, bindgen.adb, exp_ch4.adb, exp_ch13.adb, sem_warn.adb,
exp_ch3.adb, exp_ch3.ads: Minor reformatting.

2011-08-03  Pascal Obry  <obry@adacore.com>

* g-awk.ads: Minor comment fix.

2011-08-03  Sergey Rybin  <rybin@adacore.com>

* tree_io.ads (ASIS_Version_Number): Update because of the changes in
the tree structure related to discriminant constraints.
Original_Discriminant cannot be used any more for computing the
defining name for the reference to a discriminant.

2011-08-03  Ed Schonberg  <schonberg@adacore.com>

* sem_disp.adb (Is_Tag_Indeterminate): If the return type of the
function is not visibly tagged, this is not a dispatching call and
therfore is not Tag_Indeterminate, even if the function is marked as
dispatching on result.

From-SVN: r177281

gcc/ada/ChangeLog
gcc/ada/a-cfdlli.adb
gcc/ada/bindgen.adb
gcc/ada/exp_ch13.adb
gcc/ada/exp_ch3.adb
gcc/ada/exp_ch3.ads
gcc/ada/exp_ch4.adb
gcc/ada/g-awk.ads
gcc/ada/sem_disp.adb
gcc/ada/sem_warn.adb
gcc/ada/tree_io.ads

index 6abd4106cf0eb63c86fbaddcc44ce608b253c062..66c9f5ad8fb165f6cb3ab760d927e6e5dcfa2d3c 100644 (file)
@@ -1,3 +1,26 @@
+2011-08-03  Robert Dewar  <dewar@adacore.com>
+
+       * a-cfdlli.adb, bindgen.adb, exp_ch4.adb, exp_ch13.adb, sem_warn.adb,
+       exp_ch3.adb, exp_ch3.ads: Minor reformatting.
+
+2011-08-03  Pascal Obry  <obry@adacore.com>
+
+       * g-awk.ads: Minor comment fix.
+
+2011-08-03  Sergey Rybin  <rybin@adacore.com>
+
+       * tree_io.ads (ASIS_Version_Number): Update because of the changes in
+       the tree structure related to discriminant constraints.
+       Original_Discriminant cannot be used any more for computing the
+       defining name for the reference to a discriminant.
+
+2011-08-03  Ed Schonberg  <schonberg@adacore.com>
+
+       * sem_disp.adb (Is_Tag_Indeterminate): If the return type of the
+       function is not visibly tagged, this is not a dispatching call and
+       therfore is not Tag_Indeterminate, even if the function is marked as
+       dispatching on result.
+
 2011-08-03  Hristian Kirtchev  <kirtchev@adacore.com>
 
        * exp_ch13.adb: Add with and use clauses for Restrict and Rident.
index d72566a03e1be76ed5603c13100d2509294b4fef..93a88a725d635ddbfeb3584c96126261ce009b0d 100644 (file)
@@ -234,6 +234,7 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is
       C : constant Count_Type := Count_Type'Max (Source.Capacity, Capacity);
       N : Count_Type := 1;
       P : List (C);
+
    begin
       while N <= Source.Capacity loop
          P.Nodes (N).Prev := Source.Nodes (N).Prev;
@@ -241,10 +242,12 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is
          P.Nodes (N).Element := Source.Nodes (N).Element;
          N := N + 1;
       end loop;
+
       P.Free := Source.Free;
       P.Length := Source.Length;
       P.First := Source.First;
       P.Last := Source.Last;
+
       if P.Free >= 0 then
          N := Source.Capacity + 1;
          while N <= C loop
@@ -252,6 +255,7 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is
             N := N + 1;
          end loop;
       end if;
+
       return P;
    end Copy;
 
@@ -269,7 +273,8 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is
 
    begin
       if not Has_Element (Container => Container,
-                          Position  => Position) then
+                          Position  => Position)
+      then
          raise Constraint_Error with
            "Position cursor has no element";
       end if;
@@ -349,7 +354,7 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is
            "attempt to tamper with elements (list is busy)";
       end if;
 
-      for I in 1 .. Count loop
+      for J in 1 .. Count loop
          X := Container.First;
          pragma Assert (N (N (X).Next).Prev = Container.First);
 
@@ -388,7 +393,7 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is
            "attempt to tamper with elements (list is busy)";
       end if;
 
-      for I in 1 .. Count loop
+      for J in 1 .. Count loop
          X := Container.Last;
          pragma Assert (N (N (X).Prev).Next = Container.Last);
 
@@ -407,7 +412,8 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is
 
    function Element
      (Container : List;
-      Position  : Cursor) return Element_Type is
+      Position  : Cursor) return Element_Type
+   is
    begin
       if not Has_Element (Container => Container, Position  => Position) then
          raise Constraint_Error with
@@ -427,15 +433,19 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is
       Position  : Cursor := No_Element) return Cursor
    is
       From : Count_Type := Position.Node;
+
    begin
       if From = 0 and Container.Length = 0 then
          return No_Element;
       end if;
+
       if From = 0 then
          From := Container.First;
       end if;
+
       if Position.Node /= 0 and then
-        not Has_Element (Container, Position) then
+        not Has_Element (Container, Position)
+      then
          raise Constraint_Error with
            "Position cursor has no element";
       end if;
@@ -444,6 +454,7 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is
          if Container.Nodes (From).Element = Item then
             return (Node => From);
          end if;
+
          From := Container.Nodes (From).Next;
       end loop;
 
@@ -459,6 +470,7 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is
       if Container.First = 0 then
          return No_Element;
       end if;
+
       return (Node => Container.First);
    end First;
 
@@ -507,8 +519,8 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is
             Container.Free := 0;
 
          else
-            for I in Container.Free .. Container.Capacity - 1 loop
-               N (I).Next := I + 1;
+            for J in Container.Free .. Container.Capacity - 1 loop
+               N (J).Next := J + 1;
             end loop;
 
             N (Container.Capacity).Next := 0;
@@ -532,6 +544,7 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is
       function Is_Sorted (Container : List) return Boolean is
          Nodes : Node_Array renames Container.Nodes;
          Node  : Count_Type := Container.First;
+
       begin
          for I in 2 .. Container.Length loop
             if Nodes (Nodes (Node).Next).Element < Nodes (Node).Element then
@@ -618,9 +631,10 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is
          ---------------
 
          procedure Partition (Pivot, Back : Count_Type) is
-            Node : Count_Type := N (Pivot).Next;
+            Node : Count_Type;
 
          begin
+            Node := N (Pivot).Next;
             while Node /= Back loop
                if N (Node).Element < N (Pivot).Element then
                   declare
@@ -709,6 +723,7 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is
       if Position.Node = 0 then
          return False;
       end if;
+
       return Container.Nodes (Position.Node).Prev /= -1;
    end Has_Element;
 
@@ -763,7 +778,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is
       Count     : Count_Type := 1)
    is
       Position : Cursor;
-
    begin
       Insert (Container, Before, New_Item, Position, Count);
    end Insert;
@@ -893,6 +907,7 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is
             Process (Container, (Node => Node));
             Node := Container.Nodes (Node).Next;
          end loop;
+
       exception
          when others =>
             B := B - 1;
@@ -934,12 +949,14 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is
 
    function Left (Container : List; Position : Cursor) return List is
       Curs : Cursor := Position;
-      C : List (Container.Capacity) := Copy (Container, Container.Capacity);
+      C    : List (Container.Capacity) := Copy (Container, Container.Capacity);
       Node : Count_Type;
+
    begin
       if Curs = No_Element then
          return C;
       end if;
+
       if not Has_Element (Container, Curs) then
          raise Constraint_Error;
       end if;
@@ -949,6 +966,7 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is
          Delete (C, Curs);
          Curs := Next (Container, (Node => Node));
       end loop;
+
       return C;
    end Left;
 
@@ -1015,9 +1033,11 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is
       if Position.Node = 0 then
          return No_Element;
       end if;
+
       if not Has_Element (Container, Position) then
          raise Program_Error with "Position cursor has no element";
       end if;
+
       return (Node => Container.Nodes (Position.Node).Next);
    end Next;
 
@@ -1052,6 +1072,7 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is
       if not Has_Element (Container, Position) then
          raise Program_Error with "Position cursor has no element";
       end if;
+
       return (Node => Container.Nodes (Position.Node).Prev);
    end Previous;
 
@@ -1316,13 +1337,15 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is
 
    function Right (Container : List; Position : Cursor) return List is
       Curs : Cursor := First (Container);
-      C : List (Container.Capacity) := Copy (Container, Container.Capacity);
+      C    : List (Container.Capacity) := Copy (Container, Container.Capacity);
       Node : Count_Type;
+
    begin
       if Curs = No_Element then
          Clear (C);
          return C;
       end if;
+
       if Position /= No_Element and not Has_Element (Container, Position) then
          raise Constraint_Error;
       end if;
@@ -1332,6 +1355,7 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is
          Delete (C, Curs);
          Curs := Next (Container, (Node => Node));
       end loop;
+
       return C;
    end Right;
 
@@ -1537,15 +1561,19 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is
    function Strict_Equal (Left, Right : List) return Boolean is
       CL : Count_Type := Left.First;
       CR : Count_Type := Right.First;
+
    begin
       while CL /= 0 or CR /= 0 loop
          if CL /= CR or else
-           Left.Nodes (CL).Element /= Right.Nodes (CL).Element then
+           Left.Nodes (CL).Element /= Right.Nodes (CL).Element
+         then
             return False;
          end if;
+
          CL := Left.Nodes (CL).Next;
          CR := Right.Nodes (CR).Next;
       end loop;
+
       return True;
    end Strict_Equal;
 
@@ -1558,7 +1586,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is
       I, J      : Cursor)
    is
    begin
-
       if I.Node = 0 then
          raise Constraint_Error with "I cursor has no element";
       end if;
@@ -1603,7 +1630,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is
       I_Next, J_Next : Cursor;
 
    begin
-
       if I.Node = 0 then
          raise Constraint_Error with "I cursor has no element";
       end if;
@@ -1653,7 +1679,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is
       Process   : not null access procedure (Element : in out Element_Type))
    is
    begin
-
       if Position.Node = 0 then
          raise Constraint_Error with "Position cursor has no element";
       end if;
index 2d9a1c1e85e72c062bc1ca680299cd7a86e91acd..b88ed0019f7a9b2812d46b2325dc274f9e11e08d 100644 (file)
@@ -2125,7 +2125,8 @@ package body Bindgen is
 
    procedure Gen_Main_C is
       Needs_Library_Finalization : constant Boolean :=
-        not Configurable_Run_Time_On_Target and then Has_Finalizer;
+                                     not Configurable_Run_Time_On_Target
+                                       and then Has_Finalizer;
       --  For restricted run-time libraries (ZFP and Ravenscar) tasks are
       --  non-terminating, so we do not want library-level finalization.
 
@@ -2649,7 +2650,8 @@ package body Bindgen is
       --  function Get_Ada_Main_Name for details on the form of the name.
 
       Needs_Library_Finalization : constant Boolean :=
-        not Configurable_Run_Time_On_Target and then Has_Finalizer;
+                                     not Configurable_Run_Time_On_Target
+                                       and then Has_Finalizer;
       --  For restricted run-time libraries (ZFP and Ravenscar) tasks are
       --  non-terminating, so we do not want finalization.
 
@@ -3004,7 +3006,9 @@ package body Bindgen is
    procedure Gen_Output_File_C (Filename : String) is
 
       Needs_Library_Finalization : constant Boolean :=
-        not Configurable_Run_Time_On_Target and then Has_Finalizer;
+                                     not Configurable_Run_Time_On_Target
+                                       and then Has_Finalizer;
+      --  ??? seems like we repeat this cantation often, should it be global?
 
       Bfile : Name_Id;
       pragma Warnings (Off, Bfile);
index 761a2818ccb597cc070c7239b655ac3200f65c65..9f182357ee79ad81a014c10f7d72e3a4f4796bd6 100644 (file)
@@ -214,7 +214,7 @@ package body Exp_Ch13 is
 
    procedure Expand_N_Free_Statement (N : Node_Id) is
       Expr : constant Node_Id := Expression (N);
-      Typ  : Entity_Id := Etype (Expr);
+      Typ  : Entity_Id;
 
    begin
       --  Certain run-time configurations and targets do not provide support
@@ -232,6 +232,8 @@ package body Exp_Ch13 is
 
       --  Use the base type to perform the collection check
 
+      Typ := Etype (Expr);
+
       if Ekind (Typ) = E_Access_Subtype then
          Typ := Etype (Typ);
       end if;
index 6c98ef8aed6a7a884b3d343a22fb7a40f2a4a8f4..0e4094660835eb5792a53fc4bebc5ad83536bdfa 100644 (file)
@@ -841,10 +841,10 @@ package body Exp_Ch3 is
               Make_Object_Declaration (Loc,
                 Defining_Identifier =>
                   Make_Defining_Identifier (Loc, Name_uMaster),
-                Constant_Present => True,
-                Object_Definition =>
+                Constant_Present    => True,
+                Object_Definition   =>
                   New_Reference_To (Standard_Integer, Loc),
-                Expression =>
+                Expression          =>
                   Make_Explicit_Dereference (Loc,
                     New_Reference_To (RTE (RE_Current_Master), Loc)));
 
@@ -1659,9 +1659,9 @@ package body Exp_Ch3 is
       then
          if Chars (Selector_Name (Id_Ref)) /= Name_uParent then
             Append_To (Res,
-              Make_Init_Call (
-                Obj_Ref => New_Copy_Tree (First_Arg),
-                Typ     => Typ));
+              Make_Init_Call
+                (Obj_Ref => New_Copy_Tree (First_Arg),
+                 Typ     => Typ));
          end if;
       end if;
 
@@ -1852,7 +1852,7 @@ package body Exp_Ch3 is
          then
             Exp :=
               Make_Attribute_Reference (Loc,
-                Prefix =>
+                Prefix         =>
                   Make_Identifier (Loc, Name_uInit),
                 Attribute_Name => Name_Unrestricted_Access);
          end if;
@@ -1880,9 +1880,9 @@ package body Exp_Ch3 is
          then
             Append_To (Res,
               Make_Assignment_Statement (Loc,
-                Name =>
+                Name       =>
                   Make_Selected_Component (Loc,
-                    Prefix =>
+                    Prefix        =>
                       New_Copy_Tree (Lhs, New_Scope => Proc_Id),
                     Selector_Name =>
                       New_Reference_To (First_Tag_Component (Typ), Loc)),
@@ -1908,9 +1908,9 @@ package body Exp_Ch3 is
            and then not Is_Immutably_Limited_Type (Typ)
          then
             Append_To (Res,
-              Make_Adjust_Call (
-                Obj_Ref => New_Copy_Tree (Lhs),
-                Typ     => Etype (Id)));
+              Make_Adjust_Call
+                (Obj_Ref => New_Copy_Tree (Lhs),
+                 Typ     => Etype (Id)));
          end if;
 
          return Res;
@@ -2069,7 +2069,7 @@ package body Exp_Ch3 is
          Res :=
            New_List (
              Make_Procedure_Call_Statement (Loc,
-               Name =>
+               Name                   =>
                  New_Occurrence_Of (Parent_Proc, Loc),
                Parameter_Associations => Args));
 
@@ -2111,8 +2111,8 @@ package body Exp_Ch3 is
               Make_Parameter_Specification (Loc,
                 Defining_Identifier =>
                   Make_Defining_Identifier (Loc, Name_uO),
-                In_Present => True,
-                Parameter_Type =>
+                In_Present          => True,
+                Parameter_Type      =>
                   New_Reference_To (Rec_Type, Loc))));
             Set_Result_Definition (Spec_Node,
               New_Reference_To (RTE (RE_Storage_Offset), Loc));
@@ -2128,7 +2128,7 @@ package body Exp_Ch3 is
             Set_Declarations (Body_Node, New_List);
             Set_Handled_Statement_Sequence (Body_Node,
               Make_Handled_Sequence_Of_Statements (Loc,
-                Statements => New_List (
+                Statements     => New_List (
                   Make_Simple_Return_Statement (Loc,
                     Expression =>
                       Make_Attribute_Reference (Loc,
@@ -2684,14 +2684,11 @@ package body Exp_Ch3 is
 
             Append_To (Stmts,
               Make_Assignment_Statement (Loc,
-                Name =>
-                  New_Reference_To (Counter_Id, Loc),
+                Name       => New_Reference_To (Counter_Id, Loc),
                 Expression =>
                   Make_Op_Add (Loc,
-                    Left_Opnd =>
-                      New_Reference_To (Counter_Id, Loc),
-                    Right_Opnd =>
-                      Make_Integer_Literal (Loc, 1))));
+                    Left_Opnd  => New_Reference_To (Counter_Id, Loc),
+                    Right_Opnd => Make_Integer_Literal (Loc, 1))));
          end Increment_Counter;
 
          ------------------
@@ -2716,9 +2713,9 @@ package body Exp_Ch3 is
             Append_To (Decls,
               Make_Object_Declaration (Loc,
                 Defining_Identifier => Counter_Id,
-                Object_Definition =>
+                Object_Definition   =>
                   New_Reference_To (Standard_Integer, Loc),
-                Expression =>
+                Expression          =>
                   Make_Integer_Literal (Loc, 0)));
          end Make_Counter;
 
@@ -2831,10 +2828,8 @@ package body Exp_Ch3 is
                     Build_Initialization_Call
                       (Loc,
                        Make_Selected_Component (Loc,
-                         Prefix =>
-                           Make_Identifier (Loc, Name_uInit),
-                         Selector_Name =>
-                           New_Occurrence_Of (Id, Loc)),
+                         Prefix        => Make_Identifier (Loc, Name_uInit),
+                         Selector_Name => New_Occurrence_Of (Id, Loc)),
                        Typ,
                        In_Init_Proc => True,
                        Enclos_Type  => Rec_Type,
@@ -2896,13 +2891,13 @@ package body Exp_Ch3 is
             if Restricted_Profile then
                Append_To (Stmts,
                  Make_Assignment_Statement (Loc,
-                   Name =>
+                   Name       =>
                      Make_Selected_Component (Loc,
                        Prefix        => Make_Identifier (Loc, Name_uInit),
                        Selector_Name => Make_Identifier (Loc, Name_uTask_Id)),
                    Expression =>
                      Make_Attribute_Reference (Loc,
-                       Prefix =>
+                       Prefix         =>
                          Make_Selected_Component (Loc,
                            Prefix        => Make_Identifier (Loc, Name_uInit),
                            Selector_Name => Make_Identifier (Loc, Name_uATCB)),
@@ -3245,7 +3240,6 @@ package body Exp_Ch3 is
 
          De := First_Discriminant (Rec_Ent);
          Dp := First_Discriminant (Etype (Rec_Ent));
-
          while Present (De) loop
             pragma Assert (Present (Dp));
 
@@ -4657,9 +4651,9 @@ package body Exp_Ch3 is
            or else not Comes_From_Source (N)
          then
             Insert_Action_After (Init_After,
-              Make_Init_Call (
-                Obj_Ref => New_Occurrence_Of (Def_Id, Loc),
-                Typ     => Base_Type (Typ)));
+              Make_Init_Call
+                (Obj_Ref => New_Occurrence_Of (Def_Id, Loc),
+                 Typ     => Base_Type (Typ)));
 
          --  Abort allowed
 
@@ -4680,9 +4674,9 @@ package body Exp_Ch3 is
 
             declare
                L   : constant List_Id := New_List (
-                       Make_Init_Call (
-                         Obj_Ref => New_Occurrence_Of (Def_Id, Loc),
-                         Typ     => Base_Type (Typ)));
+                       Make_Init_Call
+                         (Obj_Ref => New_Occurrence_Of (Def_Id, Loc),
+                          Typ     => Base_Type (Typ)));
 
                Blk : constant Node_Id :=
                        Make_Block_Statement (Loc,
@@ -4748,11 +4742,13 @@ package body Exp_Ch3 is
             declare
                Init_Expr : constant Node_Id :=
                              Static_Initialization (Base_Init_Proc (Typ));
+
             begin
                if Present (Init_Expr) then
                   Set_Expression
                     (N, New_Copy_Tree (Init_Expr, New_Scope => Current_Scope));
                   return;
+
                else
                   Initialization_Warning (Id_Ref);
 
@@ -6647,11 +6643,11 @@ package body Exp_Ch3 is
                null;
 
             elsif (Needs_Finalization (Desig_Type)
-                     and then Convention (Desig_Type) /= Convention_Java
-                     and then Convention (Desig_Type) /= Convention_CIL)
+                    and then Convention (Desig_Type) /= Convention_Java
+                    and then Convention (Desig_Type) /= Convention_CIL)
               or else
                 (Is_Incomplete_Or_Private_Type (Desig_Type)
-                   and then No (Full_View (Desig_Type))
+                  and then No (Full_View (Desig_Type))
 
                   --  An exception is made for types defined in the run-time
                   --  because Ada.Tags.Tag itself is such a type and cannot
@@ -6670,8 +6666,8 @@ package body Exp_Ch3 is
 
               or else
                 (Is_Array_Type (Desig_Type)
-                   and then not Is_Frozen (Desig_Type)
-                   and then Needs_Finalization (Component_Type (Desig_Type)))
+                  and then not Is_Frozen (Desig_Type)
+                  and then Needs_Finalization (Component_Type (Desig_Type)))
             then
                Build_Finalization_Collection (Def_Id);
             end if;
@@ -8533,12 +8529,10 @@ package body Exp_Ch3 is
 
       Formals := New_List (
         Make_Parameter_Specification (Loc,
-          Defining_Identifier =>
-            Make_Defining_Identifier (Loc, Name_V),
-          In_Present  => True,
-          Out_Present => True,
-          Parameter_Type =>
-            New_Reference_To (Tag_Typ, Loc)));
+          Defining_Identifier => Make_Defining_Identifier (Loc, Name_V),
+          In_Present          => True,
+          Out_Present         => True,
+          Parameter_Type      => New_Reference_To (Tag_Typ, Loc)));
 
       --  F : Boolean := True
 
@@ -8547,12 +8541,9 @@ package body Exp_Ch3 is
       then
          Append_To (Formals,
            Make_Parameter_Specification (Loc,
-             Defining_Identifier =>
-               Make_Defining_Identifier (Loc, Name_F),
-             Parameter_Type =>
-               New_Reference_To (Standard_Boolean, Loc),
-             Expression =>
-               New_Reference_To (Standard_True, Loc)));
+             Defining_Identifier => Make_Defining_Identifier (Loc, Name_F),
+             Parameter_Type      => New_Reference_To (Standard_Boolean, Loc),
+             Expression          => New_Reference_To (Standard_True, Loc)));
       end if;
 
       return
@@ -8607,8 +8598,7 @@ package body Exp_Ch3 is
            Make_Function_Specification (Loc,
              Defining_Unit_Name       => Id,
              Parameter_Specifications => Profile,
-             Result_Definition        =>
-               New_Reference_To (Ret_Type, Loc));
+             Result_Definition        => New_Reference_To (Ret_Type, Loc));
       end if;
 
       if Is_Interface (Tag_Typ) then
@@ -8658,12 +8648,14 @@ package body Exp_Ch3 is
          Ret_Type := Empty;
       end if;
 
-      return Predef_Spec_Or_Body (Loc,
-        Name     => Make_TSS_Name (Tag_Typ, Name),
-        Tag_Typ  => Tag_Typ,
-        Profile  => Build_Stream_Attr_Profile (Loc, Tag_Typ, Name),
-        Ret_Type => Ret_Type,
-        For_Body => For_Body);
+      return
+        Predef_Spec_Or_Body
+          (Loc,
+           Name     => Make_TSS_Name (Tag_Typ, Name),
+           Tag_Typ  => Tag_Typ,
+           Profile  => Build_Stream_Attr_Profile (Loc, Tag_Typ, Name),
+           Ret_Type => Ret_Type,
+           For_Body => For_Body);
    end Predef_Stream_Attr_Spec;
 
    ---------------------------------
@@ -8931,14 +8923,13 @@ package body Exp_Ch3 is
             Set_Handled_Statement_Sequence (Decl,
               Make_Handled_Sequence_Of_Statements (Loc,
                 Statements => New_List (
-                  Make_Final_Call (
-                    Obj_Ref => Make_Identifier (Loc, Name_V),
-                    Typ     => Tag_Typ))));
+                  Make_Final_Call
+                    (Obj_Ref => Make_Identifier (Loc, Name_V),
+                     Typ     => Tag_Typ))));
          else
             Set_Handled_Statement_Sequence (Decl,
               Make_Handled_Sequence_Of_Statements (Loc,
-                Statements => New_List (
-                  Make_Null_Statement (Loc))));
+                Statements => New_List (Make_Null_Statement (Loc))));
          end if;
 
          Append_To (Res, Decl);
@@ -8954,7 +8945,7 @@ package body Exp_Ch3 is
    function Predefined_Primitive_Freeze
      (Tag_Typ : Entity_Id) return List_Id
    is
-      Res     : constant List_Id    := New_List;
+      Res     : constant List_Id := New_List;
       Prim    : Elmt_Id;
       Frnodes : List_Id;
 
index 54aba222f9ce8c17b1e3894949fa2cf2c24288a8..7b67e23a8cfa5048065930f8b86d0915ef2f0bd8 100644 (file)
@@ -113,22 +113,6 @@ package Exp_Ch3 is
    --  want Gigi to see the node. This function can't delete the node itself
    --  since it would confuse any remaining processing of the freeze node.
 
-   function Get_Simple_Init_Val
-     (T    : Entity_Id;
-      N    : Node_Id;
-      Size : Uint := No_Uint) return Node_Id;
-   --  For a type which Needs_Simple_Initialization (see above), prepares the
-   --  tree for an expression representing the required initial value. N is a
-   --  node whose source location used in constructing this tree which is
-   --  returned as the result of the call. The Size parameter indicates the
-   --  target size of the object if it is known (indicated by a value that is
-   --  not No_Uint and is greater than zero). If Size is not given (Size set to
-   --  No_Uint, or non-positive), then the Esize of T is used as an estimate of
-   --  the Size. The object size is needed to prepare a known invalid value for
-   --  use by Normalize_Scalars. A call to this routine where T is a scalar
-   --  type is only valid if we are in Normalize_Scalars or Initialize_Scalars
-   --  mode, or if N is the node for a 'Invalid_Value attribute node.
-
    procedure Init_Secondary_Tags
      (Typ            : Entity_Id;
       Target         : Node_Id;
@@ -155,4 +139,20 @@ package Exp_Ch3 is
    --  set to False, but if Consider_IS is set to True, then the cases above
    --  mentioning Normalize_Scalars also apply for Initialize_Scalars mode.
 
+   function Get_Simple_Init_Val
+     (T    : Entity_Id;
+      N    : Node_Id;
+      Size : Uint := No_Uint) return Node_Id;
+   --  For a type which Needs_Simple_Initialization (see above), prepares the
+   --  tree for an expression representing the required initial value. N is a
+   --  node whose source location used in constructing this tree which is
+   --  returned as the result of the call. The Size parameter indicates the
+   --  target size of the object if it is known (indicated by a value that is
+   --  not No_Uint and is greater than zero). If Size is not given (Size set to
+   --  No_Uint, or non-positive), then the Esize of T is used as an estimate of
+   --  the Size. The object size is needed to prepare a known invalid value for
+   --  use by Normalize_Scalars. A call to this routine where T is a scalar
+   --  type is only valid if we are in Normalize_Scalars or Initialize_Scalars
+   --  mode, or if N is the node for a 'Invalid_Value attribute node.
+
 end Exp_Ch3;
index 58516cdf36b2e97646d4bc9b53a2e23cd6336048..e340fee75a17d496af9e73f223ba79daf650c6fd 100644 (file)
@@ -660,14 +660,13 @@ package body Exp_Ch4 is
               Make_Raise_Program_Error (Loc,
                 Condition =>
                   Make_Op_Gt (Loc,
-                    Left_Opnd =>
+                    Left_Opnd  =>
                       Build_Get_Access_Level (Loc,
                         Make_Attribute_Reference (Loc,
-                          Prefix => Ref_Node,
+                          Prefix         => Ref_Node,
                           Attribute_Name => Name_Tag)),
                     Right_Opnd =>
-                      Make_Integer_Literal (Loc,
-                        Type_Access_Level (PtrT))),
+                      Make_Integer_Literal (Loc, Type_Access_Level (PtrT))),
                 Reason => PE_Accessibility_Check_Failed));
          end if;
       end Apply_Accessibility_Check;
@@ -974,11 +973,9 @@ package body Exp_Ch4 is
 
                New_Decl :=
                  Make_Object_Declaration (Loc,
-                   Defining_Identifier =>
-                     Make_Temporary (Loc, 'P'),
-                   Object_Definition =>
-                     New_Reference_To (PtrT, Loc),
-                   Expression =>
+                   Defining_Identifier => Make_Temporary (Loc, 'P'),
+                   Object_Definition   => New_Reference_To (PtrT, Loc),
+                   Expression          =>
                      Unchecked_Convert_To (PtrT,
                        New_Reference_To (Temp, Loc)));
 
@@ -1085,10 +1082,10 @@ package body Exp_Ch4 is
               and then Present (Associated_Collection (PtrT))
             then
                Insert_Action (N,
-                 Make_Set_Finalize_Address_Ptr_Call (
-                   Loc     => Loc,
-                   Typ     => T,
-                   Ptr_Typ => PtrT));
+                 Make_Set_Finalize_Address_Ptr_Call
+                   (Loc     => Loc,
+                    Typ     => T,
+                    Ptr_Typ => PtrT));
             end if;
          end if;
 
@@ -1111,8 +1108,7 @@ package body Exp_Ch4 is
              Object_Definition   => New_Reference_To (PtrT, Loc),
              Expression          =>
                Make_Allocator (Loc,
-                 Expression =>
-                   New_Reference_To (Etype (Exp), Loc)));
+                 Expression => New_Reference_To (Etype (Exp), Loc)));
 
          --  Copy the Comes_From_Source flag for the allocator we just built,
          --  since logically this allocator is a replacement of the original
@@ -1138,10 +1134,9 @@ package body Exp_Ch4 is
            and then Present (Associated_Collection (PtrT))
          then
             Insert_Action (N,
-              Make_Attach_Call (
-                Obj_Ref =>
-                  New_Reference_To (Temp, Loc),
-                Ptr_Typ => PtrT));
+              Make_Attach_Call
+                (Obj_Ref => New_Reference_To (Temp, Loc),
+                 Ptr_Typ => PtrT));
          end if;
 
          Rewrite (N, New_Reference_To (Temp, Loc));
@@ -1215,8 +1210,7 @@ package body Exp_Ch4 is
                Insert_Action (Exp,
                  Make_Subtype_Declaration (Loc,
                    Defining_Identifier => ConstrT,
-                   Subtype_Indication  =>
-                     Make_Subtype_From_Expr (Exp, T)));
+                   Subtype_Indication  => Make_Subtype_From_Expr (Exp, T)));
                Freeze_Itype (ConstrT, Exp);
                Rewrite (Exp, OK_Convert_To (ConstrT, Internal_Exp));
             end;
@@ -3269,9 +3263,8 @@ package body Exp_Ch4 is
          Temp_Decl :=
            Make_Object_Declaration (Loc,
              Defining_Identifier => Temp_Id,
-             Aliased_Present => True,
-             Object_Definition =>
-               New_Occurrence_Of (Etyp, Loc));
+             Aliased_Present     => True,
+             Object_Definition   => New_Occurrence_Of (Etyp, Loc));
 
          if Nkind (Expression (N)) = N_Qualified_Expression then
             Set_Expression (Temp_Decl, Expression (Expression (N)));
@@ -3294,8 +3287,7 @@ package body Exp_Ch4 is
 
          Rewrite (N,
            Make_Attribute_Reference (Loc,
-             Prefix =>
-               New_Occurrence_Of (Temp_Id, Loc),
+             Prefix         => New_Occurrence_Of (Temp_Id, Loc),
              Attribute_Name => Name_Unrestricted_Access));
 
          Analyze_And_Resolve (N, PtrT);
@@ -3332,8 +3324,7 @@ package body Exp_Ch4 is
                  Make_Attribute_Reference (Loc,
                    Prefix         => New_Occurrence_Of (E, Loc),
                    Attribute_Name => Name_Length,
-                   Expressions    => New_List (
-                     Make_Integer_Literal (Loc, J)));
+                   Expressions    => New_List (Make_Integer_Literal (Loc, J)));
 
                if J = 1 then
                   Res := Len;
@@ -3400,8 +3391,8 @@ package body Exp_Ch4 is
       if Is_Access_Constant (PtrT)
         and then Nkind (Expression (N)) = N_Qualified_Expression
         and then Compile_Time_Known_Value (Expression (Expression (N)))
-        and then Size_Known_At_Compile_Time (Etype (Expression
-                                                    (Expression (N))))
+        and then Size_Known_At_Compile_Time
+                   (Etype (Expression (Expression (N))))
         and then not Is_Record_Type (Current_Scope)
       then
          --  Here we can do the optimization. For the allocator
@@ -3436,7 +3427,7 @@ package body Exp_Ch4 is
 
          Rewrite (N,
            Make_Attribute_Reference (Loc,
-             Prefix => New_Occurrence_Of (Temp, Loc),
+             Prefix         => New_Occurrence_Of (Temp, Loc),
              Attribute_Name => Name_Unrestricted_Access));
 
          Analyze_And_Resolve (N, PtrT);
@@ -3488,8 +3479,7 @@ package body Exp_Ch4 is
                   Make_Op_Gt (Loc,
                     Left_Opnd  => Size_In_Storage_Elements (Etyp),
                     Right_Opnd =>
-                      Make_Integer_Literal (Loc,
-                        Intval => Uint_7 * (Uint_2 ** 29))),
+                      Make_Integer_Literal (Loc, Uint_7 * (Uint_2 ** 29))),
                 Reason    => SE_Object_Too_Large));
          end if;
       end if;
@@ -3603,8 +3593,7 @@ package body Exp_Ch4 is
                --  type whose definition is a concurrent type, the first
                --  argument in the Init routine has to be unchecked conversion
                --  to the corresponding record type. If the designated type is
-               --  a derived type, we also convert the argument to its root
-               --  type.
+               --  a derived type, also convert the argument to its root type.
 
                if Is_Concurrent_Type (T) then
                   Init_Arg1 :=
@@ -3672,8 +3661,8 @@ package body Exp_Ch4 is
                                 New_Occurrence_Of
                                   (Entity (Nam), Sloc (Nam)), T);
 
-                        elsif Nkind_In
-                          (Nam, N_Indexed_Component, N_Selected_Component)
+                        elsif Nkind_In (Nam, N_Indexed_Component,
+                                             N_Selected_Component)
                           and then Is_Entity_Name (Prefix (Nam))
                         then
                            Decls :=
@@ -3821,8 +3810,7 @@ package body Exp_Ch4 is
                else
                   Insert_Action (N,
                     Make_Procedure_Call_Statement (Loc,
-                      Name =>
-                        New_Reference_To (Init, Loc),
+                      Name                   => New_Reference_To (Init, Loc),
                       Parameter_Associations => Args));
                end if;
 
@@ -3832,9 +3820,9 @@ package body Exp_Ch4 is
                   --    [Deep_]Initialize (Init_Arg1);
 
                   Insert_Action (N,
-                    Make_Init_Call (
-                      Obj_Ref => New_Copy_Tree (Init_Arg1),
-                      Typ     => T));
+                    Make_Init_Call
+                      (Obj_Ref => New_Copy_Tree (Init_Arg1),
+                       Typ     => T));
 
                   if Present (Associated_Collection (PtrT)) then
 
@@ -3849,9 +3837,9 @@ package body Exp_Ch4 is
                      if VM_Target /= No_VM then
                         if Is_Controlled (T) then
                            Insert_Action (N,
-                             Make_Attach_Call (
-                               Obj_Ref => New_Copy_Tree (Init_Arg1),
-                               Ptr_Typ => PtrT));
+                             Make_Attach_Call
+                               (Obj_Ref => New_Copy_Tree (Init_Arg1),
+                                Ptr_Typ => PtrT));
                         end if;
 
                      --  Default case, generate:
@@ -3861,10 +3849,10 @@ package body Exp_Ch4 is
 
                      else
                         Insert_Action (N,
-                          Make_Set_Finalize_Address_Ptr_Call (
-                            Loc     => Loc,
-                            Typ     => T,
-                            Ptr_Typ => PtrT));
+                          Make_Set_Finalize_Address_Ptr_Call
+                            (Loc     => Loc,
+                             Typ     => T,
+                             Ptr_Typ => PtrT));
                      end if;
                   end if;
                end if;
@@ -4135,9 +4123,8 @@ package body Exp_Ch4 is
                Make_Temporary (Loc, 'A'),
              Type_Definition =>
                Make_Access_To_Object_Definition (Loc,
-                 All_Present => True,
-                 Subtype_Indication =>
-                   New_Reference_To (Typ, Loc)));
+                 All_Present        => True,
+                 Subtype_Indication => New_Reference_To (Typ, Loc)));
 
          Insert_Action (N, P_Decl);
 
@@ -4153,19 +4140,19 @@ package body Exp_Ch4 is
 
              Then_Statements => New_List (
                Make_Assignment_Statement (Sloc (Thenx),
-                 Name => New_Occurrence_Of (Cnn, Sloc (Thenx)),
+                 Name       => New_Occurrence_Of (Cnn, Sloc (Thenx)),
                  Expression =>
                    Make_Attribute_Reference (Loc,
                      Attribute_Name => Name_Unrestricted_Access,
-                     Prefix =>  Relocate_Node (Thenx)))),
+                     Prefix         =>  Relocate_Node (Thenx)))),
 
              Else_Statements => New_List (
                Make_Assignment_Statement (Sloc (Elsex),
-                 Name => New_Occurrence_Of (Cnn, Sloc (Elsex)),
+                 Name       => New_Occurrence_Of (Cnn, Sloc (Elsex)),
                  Expression =>
                    Make_Attribute_Reference (Loc,
                      Attribute_Name => Name_Unrestricted_Access,
-                     Prefix => Relocate_Node (Elsex)))));
+                     Prefix         => Relocate_Node (Elsex)))));
 
          New_N :=
            Make_Explicit_Dereference (Loc,
@@ -9209,7 +9196,6 @@ package body Exp_Ch4 is
 
       Result := New_Reference_To (Standard_True, Loc);
       C := Suitable_Element (First_Entity (Typ));
-
       while Present (C) loop
          declare
             New_Lhs : Node_Id;
index b9a7589e254011ff4b42444d43ac0c975628268c..a8604a7631782ae8de1a35e87b46868e5a8e0553 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---                     Copyright (C) 2000-2010, AdaCore                     --
+--                     Copyright (C) 2000-2011, AdaCore                     --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -215,7 +215,7 @@ package GNAT.AWK is
    --  a full AWK run. The state comprises a list of files, the current file,
    --  the number of line processed, the current line, the number of fields in
    --  the current line... A default session is provided (see Set_Current,
-   --  Current_Session and Default_Session above).
+   --  Current_Session and Default_Session below).
 
    ----------------------------
    -- Package initialization --
index 96f2ff830c2aae6ff803d06ac8b41a1cd2c6385c..369d75ef84274a2f6cc56a2612f6a996009f18d4 100644 (file)
@@ -1500,17 +1500,16 @@ package body Sem_Disp is
          if Present (Tagged_Type) and then Is_Tagged_Type (Tagged_Type) then
             Append_Unique_Elmt (Old_Subp, Primitive_Operations (Tagged_Type));
 
-            --  If Old_Subp isn't already marked as dispatching then
-            --  this is the case of an operation of an untagged private
-            --  type fulfilled by a tagged type that overrides an
-            --  inherited dispatching operation, so we set the necessary
-            --  dispatching attributes here.
+            --  If Old_Subp isn't already marked as dispatching then this is
+            --  the case of an operation of an untagged private type fulfilled
+            --  by a tagged type that overrides an inherited dispatching
+            --  operation, so we set the necessary dispatching attributes here.
 
             if not Is_Dispatching_Operation (Old_Subp) then
 
                --  If the untagged type has no discriminants, and the full
-               --  view is constrained, there will be a spurious mismatch
-               --  of subtypes on the controlling arguments, because the tagged
+               --  view is constrained, there will be a spurious mismatch of
+               --  subtypes on the controlling arguments, because the tagged
                --  type is the internal base type introduced in the derivation.
                --  Use the original type to verify conformance, rather than the
                --  base type.
@@ -1758,9 +1757,9 @@ package body Sem_Disp is
 
             begin
                --  The original corresponding operation of Prim must be an
-               --  operation of a visible ancestor of the dispatching type
-               --  S, and the original corresponding operation of S2 must
-               --  be visible.
+               --  operation of a visible ancestor of the dispatching type S,
+               --  and the original corresponding operation of S2 must be
+               --  visible.
 
                Orig_Prim := Original_Corresponding_Operation (Prim);
 
@@ -2026,6 +2025,14 @@ package body Sem_Disp is
          if not Has_Controlling_Result (Nam) then
             return False;
 
+         --  The function may have a controlling result, but if the return type
+         --  is not visibly tagged, then this is not tag-indeterminate.
+
+         elsif Is_Access_Type (Etype (Nam))
+           and then not Is_Tagged_Type (Designated_Type (Etype (Nam)))
+         then
+            return False;
+
          --  An explicit dereference means that the call has already been
          --  expanded and there is no tag to propagate.
 
@@ -2043,7 +2050,9 @@ package body Sem_Disp is
                if Is_Controlling_Actual (Actual)
                  and then not Is_Tag_Indeterminate (Actual)
                then
-                  return False; -- one operand is dispatching
+                  --  One operand is dispatching
+
+                  return False;
                end if;
 
                Next_Actual (Actual);
@@ -2066,9 +2075,9 @@ package body Sem_Disp is
       then
          return True;
 
-      --  In Ada 2005 a function that returns an anonymous access type can
-      --  dispatching, and the dereference of a call to such a function
-      --  is also tag-indeterminate.
+      --  In Ada 2005, a function that returns an anonymous access type can be
+      --  dispatching, and the dereference of a call to such a function can
+      --  also be tag-indeterminate if the call itself is.
 
       elsif Nkind (Orig_Node) = N_Explicit_Dereference
         and then Ada_Version >= Ada_2005
index 6b9dd9b415408053e1ecfe0ca1302ed9b1736fd2..fe5f38b125fd98f82cbdd915bd8360a9e13a2282 100644 (file)
@@ -3379,7 +3379,6 @@ package body Sem_Warn is
                                  Act1, Form);
 
                            else
-
                               --  For greater clarity, give name of formal.
 
                               Error_Msg_Node_2 := Form;
index f2f6ad36735231fc866c00ae9709012f666d40b9..fd7fa29cc0602c013afb9a4403f897ee21d61990 100644 (file)
@@ -47,7 +47,7 @@ package Tree_IO is
    Tree_Format_Error : exception;
    --  Raised if a format error is detected in the input file
 
-   ASIS_Version_Number : constant := 24;
+   ASIS_Version_Number : constant := 25;
    --  ASIS Version. This is used to check for consistency between the compiler
    --  used to generate trees and an ASIS application that is reading the
    --  trees. It must be incremented whenever a change is made to the tree