[multiple changes]

2009-07-20  Vadim Godunko  <godunko@adacore.com>

	* a-coorma.adb: Minor reformatting.

2009-07-20  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch3 (Build_Itype_Reference): Make public, for use on non-null
	access return types.
	* sem_ch6.adb (Analyze_Return_Type): If return is a not null subtype,
	provide an itype reference to gigi to force elaboration of the subtype
	at the proper point.

2009-07-20  Tristan Gingold  <gingold@adacore.com>

	* g-expect.adb: Avoid closeing already closed handle.

2009-07-20  Robert Dewar  <dewar@adacore.com>

	* sprint.adb (Write_Subprogram_Name): New procedure to output
	subprogram name with possible preceding $ (replaces
	Note_Implicit_Run_Time_Call).

From-SVN: r149812

gcc/ada/ChangeLog

+2009-07-20  Vadim Godunko  <godunko@adacore.com>
+
+	* a-coorma.adb: Minor reformatting.
+
+2009-07-20  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch3 (Build_Itype_Reference): Make public, for use on non-null
+	access return types.
+	* sem_ch6.adb (Analyze_Return_Type): If return is a not null subtype,
+	provide an itype reference to gigi to force elaboration of the subtype
+	at the proper point.
+
+2009-07-20  Tristan Gingold  <gingold@adacore.com>
+
+	* g-expect.adb: Avoid closeing already closed handle.
+
+2009-07-20  Robert Dewar  <dewar@adacore.com>
+
+	* sprint.adb (Write_Subprogram_Name): New procedure to output
+	subprogram name with possible preceding $ (replaces
+	Note_Implicit_Run_Time_Call).
+
 2009-07-20  Robert Dewar  <dewar@adacore.com>
 
 	* vms_data.ads: Minor reformatting

gcc/ada/a-coorma.adb

@@ -545,6 +545,10 @@ package body Ada.Containers.Ordered_Maps is
       end if;
    end Include;
 
+   ------------
+   -- Insert --
+   ------------
+
    procedure Insert
      (Container : in out Map;
       Key       : Key_Type;
@@ -605,10 +609,6 @@ package body Ada.Containers.Ordered_Maps is
       end if;
    end Insert;
 
-   ------------
-   -- Insert --
-   ------------
-
    procedure Insert
      (Container : in out Map;
       Key       : Key_Type;

gcc/ada/g-expect.adb

@@ -814,7 +814,8 @@ package body GNAT.Expect is
          Send (Process, Input);
       end if;
 
-      GNAT.OS_Lib.Close (Get_Input_Fd (Process));
+      Close (Process.Input_Fd);
+      Process.Input_Fd := Invalid_FD;
 
       declare
          Result : Expect_Match;
@@ -1305,10 +1306,14 @@ package body GNAT.Expect is
       pragma Warnings (Off, Pipe1);
       pragma Warnings (Off, Pipe2);
       pragma Warnings (Off, Pipe3);
+
    begin
       Close (Pipe1.Input);
       Close (Pipe2.Output);
-      Close (Pipe3.Output);
+
+      if Pipe3.Output /= Pipe2.Output then
+         Close (Pipe3.Output);
+      end if;
    end Set_Up_Parent_Communications;
 
    ------------------

gcc/ada/sem_ch3.adb

@@ -229,21 +229,6 @@ package body Sem_Ch3 is
    --  Needs a more complete spec--what are the parameters exactly, and what
    --  exactly is the returned value, and how is Bound affected???
 
-   procedure Build_Itype_Reference
-     (Ityp : Entity_Id;
-      Nod  : Node_Id);
-   --  Create a reference to an internal type, for use by Gigi. The back-end
-   --  elaborates itypes on demand, i.e. when their first use is seen. This
-   --  can lead to scope anomalies if the first use is within a scope that is
-   --  nested within the scope that contains  the point of definition of the
-   --  itype. The Itype_Reference node forces the elaboration of the itype
-   --  in the proper scope. The node is inserted after Nod, which is the
-   --  enclosing declaration that generated Ityp.
-   --
-   --  A related mechanism is used during expansion, for itypes created in
-   --  branches of conditionals. See Ensure_Defined in exp_util.
-   --  Could both mechanisms be merged ???
-
    procedure Build_Underlying_Full_View
      (N   : Node_Id;
       Typ : Entity_Id;
@@ -11149,6 +11134,7 @@ package body Sem_Ch3 is
       Set_Convention           (T1, Convention            (T2));
       Set_Is_Limited_Composite (T1, Is_Limited_Composite  (T2));
       Set_Is_Private_Composite (T1, Is_Private_Composite  (T2));
+      Set_Packed_Array_Type    (T1, Packed_Array_Type     (T2));
    end Copy_Array_Subtype_Attributes;
 
    -----------------------------------

gcc/ada/sem_ch3.ads

@@ -79,6 +79,21 @@ package Sem_Ch3 is
    procedure Access_Type_Declaration (T : Entity_Id; Def : Node_Id);
    --  Process an access type declaration
 
+   procedure Build_Itype_Reference
+     (Ityp : Entity_Id;
+      Nod  : Node_Id);
+   --  Create a reference to an internal type, for use by Gigi. The back-end
+   --  elaborates itypes on demand, i.e. when their first use is seen. This
+   --  can lead to scope anomalies if the first use is within a scope that is
+   --  nested within the scope that contains  the point of definition of the
+   --  itype. The Itype_Reference node forces the elaboration of the itype
+   --  in the proper scope. The node is inserted after Nod, which is the
+   --  enclosing declaration that generated Ityp.
+   --
+   --  A related mechanism is used during expansion, for itypes created in
+   --  branches of conditionals. See Ensure_Defined in exp_util.
+   --  Could both mechanisms be merged ???
+
    procedure Check_Abstract_Overriding (T : Entity_Id);
    --  Check that all abstract subprograms inherited from T's parent type
    --  have been overridden as required, and that nonabstract subprograms

gcc/ada/sem_ch6.adb

@@ -641,6 +641,11 @@ package body Sem_Ch6 is
          then
             null;
 
+         elsif Etype (Base_Type (R_Type)) = R_Stm_Type
+           and then Is_Null_Extension (Base_Type (R_Type))
+         then
+            null;
+
          else
             Error_Msg_N
               ("wrong type for return_subtype_indication", Subtype_Ind);
@@ -1322,9 +1327,32 @@ package body Sem_Ch6 is
             then
                Set_Etype  (Designator,
                  Create_Null_Excluding_Itype
-                   (T           => Typ,
-                    Related_Nod => N,
-                    Scope_Id    => Scope (Current_Scope)));
+                  (T           => Typ,
+                   Related_Nod => N,
+                   Scope_Id    => Scope (Current_Scope)));
+
+               --  The new subtype must be elaborated before use because
+               --  it is visible outside of the function. However its base
+               --  type may not be frozen yet, so the reference that will
+               --  force elaboration must be attached to the freezing of
+               --  the base type.
+
+               if Is_Frozen (Typ) then
+                  Build_Itype_Reference
+                    (Etype (Designator), Parent (N));
+               else
+                  Ensure_Freeze_Node (Typ);
+
+                  declare
+                     IR : constant Node_Id :=
+                             Make_Itype_Reference (Sloc (N));
+
+                  begin
+                     Set_Itype (IR, Etype (Designator));
+                     Append_Freeze_Actions (Typ, New_List (IR));
+                  end;
+               end if;
+
             else
                Set_Etype (Designator, Typ);
             end if;

gcc/ada/sprint.adb

@@ -164,11 +164,6 @@ package body Sprint is
    procedure Indent_End;
    --  Decrease indentation level
 
-   procedure Note_Implicit_Run_Time_Call (N : Node_Id);
-   --  N is the Name field of a function call or procedure statement call.
-   --  The effect of the call is to output a $ if the call is identified as
-   --  an implicit call to a run time routine.
-
    procedure Print_Debug_Line (S : String);
    --  Used to print output lines in Debug_Generated_Code mode (this is used
    --  as the argument for a call to Set_Special_Output in package Output).
@@ -328,6 +323,11 @@ package body Sprint is
    --  Like Write_Str_With_Col_Check, but sets debug Sloc of current debug
    --  node to first non-blank character if a current debug node is active.
 
+   procedure Write_Subprogram_Name (N : Node_Id);
+   --  N is the Name field of a function call or procedure statement call.
+   --  The effect of the call is to output the name, preceded by a $ if the
+   --  call is identified as an implicit call to a run time routine.
+
    procedure Write_Uint_With_Col_Check (U : Uint; Format : UI_Format);
    --  Write Uint (using UI_Write) with initial column check, and possible
    --  initial Write_Indent (to get new line) if current line is too full.
@@ -395,30 +395,6 @@ package body Sprint is
       Indent := Indent - 3;
    end Indent_End;
 
-   ---------------------------------
-   -- Note_Implicit_Run_Time_Call --
-   ---------------------------------
-
-   procedure Note_Implicit_Run_Time_Call (N : Node_Id) is
-   begin
-      if not Comes_From_Source (N)
-        and then Is_Entity_Name (N)
-      then
-         declare
-            Ent : constant Entity_Id := Entity (N);
-         begin
-            if not In_Extended_Main_Source_Unit (Ent)
-              and then
-                Is_Predefined_File_Name
-                  (Unit_File_Name (Get_Source_Unit (Ent)))
-            then
-               Col_Check (Length_Of_Name (Chars (Ent)));
-               Write_Char ('$');
-            end if;
-         end;
-      end if;
-   end Note_Implicit_Run_Time_Call;
-
    --------
    -- pg --
    --------
@@ -1749,8 +1725,7 @@ package body Sprint is
 
          when N_Function_Call =>
             Set_Debug_Sloc;
-            Note_Implicit_Run_Time_Call (Name (Node));
-            Sprint_Node (Name (Node));
+            Write_Subprogram_Name (Name (Node));
             Sprint_Opt_Paren_Comma_List (Parameter_Associations (Node));
 
          when N_Function_Instantiation =>
@@ -2468,8 +2443,7 @@ package body Sprint is
          when N_Procedure_Call_Statement =>
             Write_Indent;
             Set_Debug_Sloc;
-            Note_Implicit_Run_Time_Call (Name (Node));
-            Sprint_Node (Name (Node));
+            Write_Subprogram_Name (Name (Node));
             Sprint_Opt_Paren_Comma_List (Parameter_Associations (Node));
             Write_Char (';');
 
@@ -4266,6 +4240,39 @@ package body Sprint is
       end if;
    end Write_Str_With_Col_Check_Sloc;
 
+   ---------------------------
+   -- Write_Subprogram_Name --
+   ---------------------------
+
+   procedure Write_Subprogram_Name (N : Node_Id) is
+   begin
+      if not Comes_From_Source (N)
+        and then Is_Entity_Name (N)
+      then
+         declare
+            Ent : constant Entity_Id := Entity (N);
+         begin
+            if not In_Extended_Main_Source_Unit (Ent)
+              and then
+                Is_Predefined_File_Name
+                  (Unit_File_Name (Get_Source_Unit (Ent)))
+            then
+               --  Run-time routine name, output name with a preceding dollar
+               --  making sure that we do not get a line split between them.
+
+               Col_Check (Length_Of_Name (Chars (Ent)) + 1);
+               Write_Char ('$');
+               Write_Name (Chars (Ent));
+               return;
+            end if;
+         end;
+      end if;
+
+      --  Normal case, not a run-time routine name
+
+      Sprint_Node (N);
+   end Write_Subprogram_Name;
+
    -------------------------------
    -- Write_Uint_With_Col_Check --
    -------------------------------