[multiple changes]

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

	* exp_ch5.adb (Expand_Iterator_Loop): indicate that the cursor is
	modified in the source, to prevent spurious warnings when compiling
	with -gnatg.

2011-08-03  Thomas Quinot  <quinot@adacore.com>

	* a-except-2005.adb: Minor reformatting.

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

	* sem_warn.adb (Check_One_Unit): if the only mention of a withed unit
	is a renaming declaration in the private part of a package, do not emit
	a warning that the with_clause could be moved because the renaming may
	be used in the body or in a child unit.

2011-08-03  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch6.adb (Make_Build_In_Place_Call_In_Object_Declaration):
	Propagate the Comes_From_Source attribute from the original return
	object to the renaming.

2011-08-03  Jose Ruiz  <ruiz@adacore.com>

	* exp_ch7.adb (Build_Raise_Statement): Do not call
	Raise_From_Controlled_Operation when this routine is not present in
	the run-time library.
	(Cleanup_Protected_Object, Cleanup_Task): For restricted run-time
	libraries (Ravenscar), tasks are non-terminating, and protected objects
	and tasks can only appear at library level, so we do not want
	finalization of protected objects nor tasks.
	* exp_intr.adb: Minor clarification in comment.
	bindgen.adb (Gen_Adainit_Ada, Gen_Main_C, Gen_Output_File_Ada,
	Gen_Output_File_C): Remove references to finalization of library-level
	objects when using restricted run-time libraries.

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

	* sem_ch3.adb (Build_Discriminant_Constraints): Set
	Original_Discriminant only if the parent type is a generic formal.

From-SVN: r177278

9 files changed, 164 insertions, 80 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 0a1c510..9cf21ed 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,45 @@
+2011-08-03  Ed Schonberg  <schonberg@adacore.com>
+
+	* exp_ch5.adb (Expand_Iterator_Loop): indicate that the cursor is
+	modified in the source, to prevent spurious warnings when compiling
+	with -gnatg.
+
+2011-08-03  Thomas Quinot  <quinot@adacore.com>
+
+	* a-except-2005.adb: Minor reformatting.
+
+2011-08-03  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_warn.adb (Check_One_Unit): if the only mention of a withed unit
+	is a renaming declaration in the private part of a package, do not emit
+	a warning that the with_clause could be moved because the renaming may
+	be used in the body or in a child unit.
+
+2011-08-03  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* exp_ch6.adb (Make_Build_In_Place_Call_In_Object_Declaration):
+	Propagate the Comes_From_Source attribute from the original return
+	object to the renaming.
+
+2011-08-03  Jose Ruiz  <ruiz@adacore.com>
+
+	* exp_ch7.adb (Build_Raise_Statement): Do not call
+	Raise_From_Controlled_Operation when this routine is not present in
+	the run-time library.
+	(Cleanup_Protected_Object, Cleanup_Task): For restricted run-time
+	libraries (Ravenscar), tasks are non-terminating, and protected objects
+	and tasks can only appear at library level, so we do not want
+	finalization of protected objects nor tasks.
+	* exp_intr.adb: Minor clarification in comment.
+	bindgen.adb (Gen_Adainit_Ada, Gen_Main_C, Gen_Output_File_Ada,
+	Gen_Output_File_C): Remove references to finalization of library-level
+	objects when using restricted run-time libraries.
+
+2011-08-03  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch3.adb (Build_Discriminant_Constraints): Set
+	Original_Discriminant only if the parent type is a generic formal.
+
 2011-08-03  Hristian Kirtchev  <kirtchev@adacore.com>
 
 	* exp_ch13.adb: Add with and use clause for Targparm;
diff --git a/gcc/ada/a-except-2005.adb b/gcc/ada/a-except-2005.adb
index e69e859..e84b0e9 100644
--- a/gcc/ada/a-except-2005.adb
+++ b/gcc/ada/a-except-2005.adb
@@ -880,7 +880,7 @@ package body Ada.Exceptions is
    procedure Raise_From_Controlled_Operation
      (X : Ada.Exceptions.Exception_Occurrence)
    is
-      Prev_Exc  : constant EOA := Get_Current_Excep.all;
+      Prev_Exc : constant EOA := Get_Current_Excep.all;
 
    begin
       --  We're raising an exception during finalization. If the finalization
@@ -906,7 +906,7 @@ package body Ada.Exceptions is
               (Orig_Msg'First .. Orig_Msg'First + Orig_Prefix_Length - 1);
 
          begin
-            --  Message already has the proper prefix, just re-reraise
+            --  Message already has the proper prefix, just re-raise
 
             if Orig_Prefix = Prefix then
                Raise_Exception_No_Defer
diff --git a/gcc/ada/bindgen.adb b/gcc/ada/bindgen.adb
index eeec470..2d9a1c1 100644
--- a/gcc/ada/bindgen.adb
+++ b/gcc/ada/bindgen.adb
@@ -665,10 +665,11 @@ package body Bindgen is
               """__gnat_handler_installed"");");
 
          --  The import of the soft link which performs library-level object
-         --  finalization is not needed for VM targets. Regular Ada is used in
-         --  that case.
+         --  finalization is not needed for VM targets; regular Ada is used in
+         --  that case. For restricted run-time libraries (ZFP and Ravenscar)
+         --  tasks are non-terminating, so we do not want finalization.
 
-         if VM_Target = No_VM then
+         if VM_Target = No_VM and then not Configurable_Run_Time_On_Target then
             WBI ("");
             WBI ("      type No_Param_Proc is access procedure;");
             WBI ("      Finalize_Library_Objects : No_Param_Proc;");
@@ -926,32 +927,38 @@ package body Bindgen is
          WBI ("      Initialize_Stack_Limit;");
       end if;
 
-      --  Attach Finalize_Library to the right softlink
+      --  Attach Finalize_Library to the right soft link. Do it only when not
+      --  using a restricted run time, in which case tasks are
+      --  non-terminating, so we do not want library-level finalization.
 
-      if not Suppress_Standard_Library_On_Target then
-         WBI ("");
+      if not Configurable_Run_Time_On_Target then
+         if not Suppress_Standard_Library_On_Target then
+            WBI ("");
 
-         if VM_Target = No_VM then
-            if Lib_Final_Built then
-               Set_String ("      Finalize_Library_Objects := ");
-               Set_String ("Finalize_Library'access;");
-            else
-               Set_String ("      Finalize_Library_Objects := null;");
-            end if;
+            if VM_Target = No_VM then
+               if Lib_Final_Built then
+                  Set_String ("      Finalize_Library_Objects := ");
+                  Set_String ("Finalize_Library'access;");
+               else
+                  Set_String ("      Finalize_Library_Objects := null;");
+               end if;
 
-         --  On VM targets use regular Ada to set the soft link
+            --  On VM targets use regular Ada to set the soft link
 
-         else
-            if Lib_Final_Built then
-               Set_String ("      System.Soft_Links.Finalize_Library_Objects");
-               Set_String (" := Finalize_Library'access;");
             else
-               Set_String ("      System.Soft_Links.Finalize_Library_Objects");
-               Set_String (" := null;");
+               if Lib_Final_Built then
+                  Set_String
+                    ("      System.Soft_Links.Finalize_Library_Objects");
+                  Set_String (" := Finalize_Library'access;");
+               else
+                  Set_String
+                    ("      System.Soft_Links.Finalize_Library_Objects");
+                  Set_String (" := null;");
+               end if;
             end if;
-         end if;
 
-         Write_Statement_Buffer;
+            Write_Statement_Buffer;
+         end if;
       end if;
 
       --  Generate elaboration calls
@@ -2117,7 +2124,10 @@ package body Bindgen is
    ----------------
 
    procedure Gen_Main_C is
-      Needs_Library_Finalization : constant Boolean := Has_Finalizer;
+      Needs_Library_Finalization : constant Boolean :=
+        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.
 
    begin
       if Exit_Status_Supported_On_Target then
@@ -2638,7 +2648,10 @@ package body Bindgen is
       --  Name to be used for generated Ada main program. See the body of
       --  function Get_Ada_Main_Name for details on the form of the name.
 
-      Needs_Library_Finalization : constant Boolean := Has_Finalizer;
+      Needs_Library_Finalization : constant Boolean :=
+        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.
 
       Bfiles : Name_Id;
       --  Name of generated bind file (spec)
@@ -2990,7 +3003,8 @@ package body Bindgen is
 
    procedure Gen_Output_File_C (Filename : String) is
 
-      Needs_Library_Finalization : constant Boolean := Has_Finalizer;
+      Needs_Library_Finalization : constant Boolean :=
+        not Configurable_Run_Time_On_Target and then Has_Finalizer;
 
       Bfile : Name_Id;
       pragma Warnings (Off, Bfile);
diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb
index cba68fb..5f3e300 100644
--- a/gcc/ada/exp_ch5.adb
+++ b/gcc/ada/exp_ch5.adb
@@ -3020,6 +3020,12 @@ package body Exp_Ch5 is
                     Selector_Name =>
                       Make_Identifier (Loc, Name_Init))));
 
+            --  The cursor is not modified in the source, but of course will
+            --  be updated in the generated code. Indicate that it is actually
+            --  set to prevent spurious warnings.
+
+            Set_Never_Set_In_Source (Cursor, False);
+
             --  If the range of iteration is given by a function call that
             --  returns a container, the finalization actions have been saved
             --  in the Condition_Actions of the iterator. Insert them now at
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 98b6ad0..1bb0a71 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -7787,7 +7787,10 @@ package body Exp_Ch6 is
 
             Preserve_Comes_From_Source
               (Object_Decl, Original_Node (Object_Decl));
-            Set_Comes_From_Source (Obj_Def_Id, True);
+
+            Preserve_Comes_From_Source
+              (Obj_Def_Id, Original_Node (Object_Decl));
+
             Set_Comes_From_Source (Renaming_Def_Id, False);
          end;
       end if;
diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index ad48e5a..e72c19b 100644
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -316,7 +316,7 @@ package body Exp_Ch7 is
    --          Save_Occurrence (E_Id, Get_Current_Excep.all.all);
    --       end if;
    --
-   --  If flag For_Library is set:
+   --  If flag For_Library is set (and not in restricted profile):
    --
    --    when others =>
    --       if not Raised_Id then
@@ -769,7 +769,7 @@ package body Exp_Ch7 is
                   Prefix =>
                     New_Reference_To (RTE (RE_Get_Current_Excep), Loc)))));
 
-      if For_Library then
+      if For_Library and then not Restricted_Profile then
          Proc_To_Call := RTE (RE_Save_Library_Occurrence);
 
       else
@@ -2922,8 +2922,15 @@ package body Exp_Ch7 is
       Raise_Id : Entity_Id;
 
    begin
-      if VM_Target = No_VM then
+      if VM_Target /= No_VM then
+         Raise_Id := RTE (RE_Reraise_Occurrence);
+
+      --  Standard run-time library
+      elsif RTE_Available (RE_Raise_From_Controlled_Operation) then
          Raise_Id := RTE (RE_Raise_From_Controlled_Operation);
+
+      --  Restricted runtime: exception messages are not supported and hence
+      --  Raise_From_Controlled_Operation is not supported.
       else
          Raise_Id := RTE (RE_Reraise_Occurrence);
       end if;
@@ -3166,12 +3173,21 @@ package body Exp_Ch7 is
       Loc : constant Source_Ptr := Sloc (N);
 
    begin
-      return
-        Make_Procedure_Call_Statement (Loc,
-          Name =>
-            New_Reference_To (RTE (RE_Finalize_Protection), Loc),
-          Parameter_Associations =>
-            New_List (Concurrent_Ref (Ref)));
+      --  For restricted run-time libraries (Ravenscar), tasks are
+      --  non-terminating, and protected objects can only appear at library
+      --  level, so we do not want finalization of protected objects.
+
+      if Restricted_Profile then
+         return Empty;
+
+      else
+         return
+           Make_Procedure_Call_Statement (Loc,
+             Name =>
+               New_Reference_To (RTE (RE_Finalize_Protection), Loc),
+             Parameter_Associations =>
+               New_List (Concurrent_Ref (Ref)));
+      end if;
    end Cleanup_Protected_Object;
 
    ------------------
@@ -3184,12 +3200,21 @@ package body Exp_Ch7 is
    is
       Loc  : constant Source_Ptr := Sloc (N);
    begin
-      return
-        Make_Procedure_Call_Statement (Loc,
-          Name =>
-            New_Reference_To (RTE (RE_Free_Task), Loc),
-          Parameter_Associations =>
-            New_List (Concurrent_Ref (Ref)));
+      --  For restricted run-time libraries (Ravenscar), tasks are
+      --  non-terminating and they can only appear at library level, so we do
+      --  not want finalization of task objects.
+
+      if Restricted_Profile then
+         return Empty;
+
+      else
+         return
+           Make_Procedure_Call_Statement (Loc,
+             Name =>
+               New_Reference_To (RTE (RE_Free_Task), Loc),
+             Parameter_Associations =>
+               New_List (Concurrent_Ref (Ref)));
+      end if;
    end Cleanup_Task;
 
    ------------------------------
diff --git a/gcc/ada/exp_intr.adb b/gcc/ada/exp_intr.adb
index 21585ad..a08a9e3 100644
--- a/gcc/ada/exp_intr.adb
+++ b/gcc/ada/exp_intr.adb
@@ -31,7 +31,6 @@ with Errout;   use Errout;
 with Exp_Atag; use Exp_Atag;
 with Exp_Ch4;  use Exp_Ch4;
 with Exp_Ch7;  use Exp_Ch7;
-with Exp_Ch11; use Exp_Ch11;
 with Exp_Code; use Exp_Code;
 with Exp_Fixd; use Exp_Fixd;
 with Exp_Util; use Exp_Util;
@@ -965,7 +964,6 @@ package body Exp_Intr is
                New_Reference_To (Standard_False, Loc));
 
          Append_To (Stmts, Raised_Decl);
-         Analyze (Raised_Decl);
 
          Exc_Occ_Decl :=
            Make_Object_Declaration (Loc,
@@ -975,7 +973,6 @@ package body Exp_Intr is
          Set_No_Initialization (Exc_Occ_Decl);
 
          Append_To (Stmts, Exc_Occ_Decl);
-         Analyze (Exc_Occ_Decl);
 
          Final_Code := New_List (
            Make_Block_Statement (Loc,
@@ -1034,21 +1031,7 @@ package body Exp_Intr is
                   At_End_Proc =>
                     New_Occurrence_Of (RTE (RE_Abort_Undefer_Direct), Loc)));
 
-            --  We now expand the exception (at end) handler. We set a
-            --  temporary parent pointer since we have not attached Blk
-            --  to the tree yet.
-
-            Set_Parent (Blk, N);
-            Analyze (Blk);
-            Expand_At_End_Handler
-              (Handled_Statement_Sequence (Blk), Entity (Identifier (Blk)));
             Append (Blk, Stmts);
-
-            --  We kill saved current values, since analyzing statements not
-            --  properly attached to the tree can set wrong current values.
-
-            Kill_Current_Values;
-
          else
             Append_List_To (Stmts, Final_Code);
          end if;
@@ -1129,7 +1112,7 @@ package body Exp_Intr is
       Append_To (Stmts, Free_Node);
       Set_Storage_Pool (Free_Node, Pool);
 
-      --  Attach to tree before analysis of generated subtypes below.
+      --  Attach to tree before analysis of generated subtypes below
 
       Set_Parent (Stmts, Parent (N));
 
@@ -1142,17 +1125,15 @@ package body Exp_Intr is
          if Is_RTE (Pool, RE_SS_Pool) then
             null;
 
-         elsif Is_Class_Wide_Type (Etype (Pool)) then
+         --  Case of a class-wide pool type: make a dispatching call to
+         --  Deallocate through the class-wide Deallocate_Any.
 
-            --  Case of a class-wide pool type: make a dispatching call
-            --  to Deallocate through the class-wide Deallocate_Any.
+         elsif Is_Class_Wide_Type (Etype (Pool)) then
+            Set_Procedure_To_Call (Free_Node, RTE (RE_Deallocate_Any));
 
-            Set_Procedure_To_Call (Free_Node,
-              RTE (RE_Deallocate_Any));
+         --  Case of a specific pool type: make a statically bound call
 
          else
-            --  Case of a specific pool type: make a statically bound call
-
             Set_Procedure_To_Call (Free_Node,
               Find_Prim_Op (Etype (Pool), Name_Deallocate));
          end if;
@@ -1261,7 +1242,8 @@ package body Exp_Intr is
       --
       --  Generate:
       --    if Raised then
-      --       Reraise_Occurrence (Exc_Occ);               --  for .NET
+      --       Reraise_Occurrence (Exc_Occ);               --  for .NET and
+      --                                                   --  restricted RTS
       --         <or>
       --       Raise_From_Controlled_Operation (Exc_Occ);  --  all other cases
       --    end if;
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 42303e7..1851f93 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -8354,14 +8354,11 @@ package body Sem_Ch3 is
                      Error_Msg_N ("& does not match any discriminant", Id);
                      return New_Elmt_List;
 
-                  --  The following is only useful for the benefit of generic
-                  --  instances but it does not interfere with other
-                  --  processing for the non-generic case so we do it in all
-                  --  cases (for generics this statement is executed when
-                  --  processing the generic definition, see comment at the
-                  --  beginning of this if statement).
+                  --  If the parent type is a generic formal, preserve the
+                  --  name of the discriminant for subsequent instances.
+                  --  see comment at the beginning of this if statement.
 
-                  else
+                  elsif Is_Generic_Type (Root_Type (T)) then
                      Set_Original_Discriminant (Id, Discr);
                   end if;
                end if;
diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb
index fdd32ba..6b9dd9b 100644
--- a/gcc/ada/sem_warn.adb
+++ b/gcc/ada/sem_warn.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1999-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 1999-2011, Free Software Foundation, Inc.         --
 --                                                                          --
 -- 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- --
@@ -2425,9 +2425,19 @@ package body Sem_Warn is
                               Pack :=
                                 Find_Package_Renaming
                                   (Spec_Entity (Munite), Lunit);
+                           else
+                              Pack := Empty;
                            end if;
 
-                           if Unreferenced_In_Spec (Item) then
+                           --  If a renaming is present in the spec do not warn
+                           --  because the body or child unit may depend on it.
+
+                           if Present (Pack)
+                             and then Renamed_Entity (Pack) = Lunit
+                           then
+                              exit;
+
+                           elsif Unreferenced_In_Spec (Item) then
                               Error_Msg_N -- CODEFIX
                                 ("?unit& is not referenced in spec!",
                                  Name (Item));
@@ -3367,10 +3377,15 @@ package body Sem_Warn is
                               Error_Msg_FE
                                 ("`IN OUT` prefix overlaps with actual for&?",
                                  Act1, Form);
+
                            else
+
+                              --  For greater clarity, give name of formal.
+
+                              Error_Msg_Node_2 := Form;
                               Error_Msg_FE
-                                ("writable actual overlaps with actual for&?",
-                                 Act1, Form);
+                                ("writable actual for & overlaps with"
+                                  & "  actual for&?", Act1, Form);
                            end if;
 
                         else