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

	* sem_util.ads, sem_unit.adb (Type_Without_Stream_Operation): determine
	whether a type lacks user-defined Read or Write operations, or has a
	component that lacks them.
	* sem_attr.adb (Check_Stream_Attribute): if restriction
	No_Default_Stream_Attributes is active, verify that all subcomponent
	types of the target have user-defined stream operations, and report
	error otherwise.
	* exp_ch3.adb (Stream_Operqtion_OK): use Type_Without_Stream_Operation.
	* exp_strm.adb: Build_Elementary_Input_Call,
	Build_Elementary_Write_Call): remove checks for restriction
	No_Default_Stream_Attributes, now checked in semantics.

2011-08-04  Vincent Celier  <celier@adacore.com>

	* prj-conf.ads, prj-conf.adb (Do_Autoconf): If there is no --RTS
	switches on the command line, look for all valid --RTS switches in the
	Builder switches and for each language use the first runtime name found
	to invoke gprconfig.
	(Get_Or_Create_Configuration_File): Warn if --RTS is specified on the
	command line and there is no auto-configuration.
	(Runtime_Name_Set_For): New function.

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

	* exp_ch7.adb (Build_Object_Declarations): Do not generate the
	elaborate initialization expression for variable Abort when processing
	a package body or a declaration.
	(Create_Finalizer): Propagate the package context when creating the
	exception-related variables.
	* exp_ch7.ads (Build_Object_Declarations): New formal parameter
	For_Package along with usage comment.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@177407 138bc75d-0d04-0410-961f-82ee72b054a4

10 files changed, 290 insertions, 98 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index c6b8cd82a23..6162166601a 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,37 @@
+2011-08-04  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_util.ads, sem_unit.adb (Type_Without_Stream_Operation): determine
+	whether a type lacks user-defined Read or Write operations, or has a
+	component that lacks them.
+	* sem_attr.adb (Check_Stream_Attribute): if restriction
+	No_Default_Stream_Attributes is active, verify that all subcomponent
+	types of the target have user-defined stream operations, and report
+	error otherwise.
+	* exp_ch3.adb (Stream_Operqtion_OK): use Type_Without_Stream_Operation.
+	* exp_strm.adb: Build_Elementary_Input_Call,
+	Build_Elementary_Write_Call): remove checks for restriction
+	No_Default_Stream_Attributes, now checked in semantics.
+
+2011-08-04  Vincent Celier  <celier@adacore.com>
+
+	* prj-conf.ads, prj-conf.adb (Do_Autoconf): If there is no --RTS
+	switches on the command line, look for all valid --RTS switches in the
+	Builder switches and for each language use the first runtime name found
+	to invoke gprconfig.
+	(Get_Or_Create_Configuration_File): Warn if --RTS is specified on the
+	command line and there is no auto-configuration.
+	(Runtime_Name_Set_For): New function.
+
+2011-08-04  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* exp_ch7.adb (Build_Object_Declarations): Do not generate the
+	elaborate initialization expression for variable Abort when processing
+	a package body or a declaration.
+	(Create_Finalizer): Propagate the package context when creating the
+	exception-related variables.
+	* exp_ch7.ads (Build_Object_Declarations): New formal parameter
+	For_Package along with usage comment.
+
 2011-08-04  Arnaud Charlet  <charlet@adacore.com>
 
 	* gcc-interface/Makefile.in: Clean up targets.
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index 6d73822c356..7f495ace586 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -8964,58 +8964,6 @@ package body Exp_Ch3 is
    is
       Has_Predefined_Or_Specified_Stream_Attribute : Boolean := False;
 
-      function Needs_Elementary_Stream_Operation
-        (T : Entity_Id) return Boolean;
-      --  AI05-0161 : if the restriction No_Default_Stream_Attributes is active
-      --  then we can generate stream subprograms for records that have scalar
-      --  subcomponents only if those subcomponents have user-defined stream
-      --  subprograms. For elementary types only 'Read and 'Write are needed.
-
-      ---------------------------------------
-      -- Needs_Elementary_Stream_Operation --
-      ---------------------------------------
-
-      function Needs_Elementary_Stream_Operation
-        (T : Entity_Id) return Boolean
-      is
-      begin
-         if not Restriction_Active (No_Default_Stream_Attributes) then
-            return False;
-
-         elsif Is_Elementary_Type (T) then
-            return No (TSS (T, TSS_Stream_Read))
-              or else No (TSS (T, TSS_Stream_Write));
-
-         elsif Is_Array_Type (T) then
-            return Needs_Elementary_Stream_Operation (Component_Type (T));
-
-         elsif Is_Record_Type (T) then
-            declare
-               Comp : Entity_Id;
-
-            begin
-               Comp := First_Component (T);
-               while Present (Comp) loop
-                  if Needs_Elementary_Stream_Operation (Etype (Comp)) then
-                     return True;
-                  end if;
-                  Next_Component (Comp);
-               end loop;
-               return False;
-            end;
-
-         elsif Is_Private_Type (T)
-           and then Present (Full_View (T))
-         then
-            return Needs_Elementary_Stream_Operation (Full_View (T));
-
-         else
-            return False;
-         end if;
-      end Needs_Elementary_Stream_Operation;
-
-   --  Start processing for Stream_Operation_OK
-
    begin
       --  Special case of a limited type extension: a default implementation
       --  of the stream attributes Read or Write exists if that attribute
@@ -9109,7 +9057,7 @@ package body Exp_Ch3 is
         and then not Restriction_Active (No_Dispatch)
         and then not No_Run_Time_Mode
         and then RTE_Available (RE_Tag)
-        and then not Needs_Elementary_Stream_Operation (Typ)
+        and then No (Type_Without_Stream_Operation (Typ))
         and then RTE_Available (RE_Root_Stream_Type)
         and then not Is_RTE (Typ, RE_Finalization_Collection);
    end Stream_Operation_OK;
diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index 8343d2af0b4..91384420a3e 100644
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -1558,7 +1558,8 @@ package body Exp_Ch7 is
            and then Exceptions_OK
          then
             Prepend_List_To (Finalizer_Decls,
-              Build_Object_Declarations (Loc, Abort_Id, E_Id, Raised_Id));
+              Build_Object_Declarations
+                (Loc, Abort_Id, E_Id, Raised_Id, For_Package));
          end if;
 
          --  Create the body of the finalizer
@@ -2926,10 +2927,11 @@ package body Exp_Ch7 is
    -------------------------------
 
    function Build_Object_Declarations
-     (Loc       : Source_Ptr;
-      Abort_Id  : Entity_Id;
-      E_Id      : Entity_Id;
-      Raised_Id : Entity_Id) return List_Id
+     (Loc         : Source_Ptr;
+      Abort_Id    : Entity_Id;
+      E_Id        : Entity_Id;
+      Raised_Id   : Entity_Id;
+      For_Package : Boolean := False) return List_Id
    is
       A_Expr : Node_Id;
       E_Decl : Node_Id;
@@ -2956,8 +2958,12 @@ package body Exp_Ch7 is
       --  does not include routine Raise_From_Controlled_Operation which is the
       --  the sole user of flag Abort.
 
+      --  This is not needed for library-level finalizers as they are called
+      --  by the environment task and cannot be aborted.
+
       if Abort_Allowed
         and then VM_Target = No_VM
+        and then not For_Package
       then
          declare
             Temp_Id : constant Entity_Id := Make_Temporary (Loc, 'E');
diff --git a/gcc/ada/exp_ch7.ads b/gcc/ada/exp_ch7.ads
index 7a7f8746701..68e5e7538d9 100644
--- a/gcc/ada/exp_ch7.ads
+++ b/gcc/ada/exp_ch7.ads
@@ -58,10 +58,11 @@ package Exp_Ch7 is
    --  the controlling operations.
 
    function Build_Object_Declarations
-     (Loc       : Source_Ptr;
-      Abort_Id  : Entity_Id;
-      E_Id      : Entity_Id;
-      Raised_Id : Entity_Id) return List_Id;
+     (Loc         : Source_Ptr;
+      Abort_Id    : Entity_Id;
+      E_Id        : Entity_Id;
+      Raised_Id   : Entity_Id;
+      For_Package : Boolean := False) return List_Id;
    --  Subsidiary to Make_Deep_Array_Body and Make_Deep_Record_Body. Return a
    --  list containing the object declarations of boolean flag Abort_Id, the
    --  exception occurrence E_Id and boolean flag Raised_Id.
@@ -70,7 +71,7 @@ package Exp_Ch7 is
    --                  Exception_Identity (Get_Current_Excep.all) =
    --                    Standard'Abort_Signal'Identity;
    --      <or>
-   --    Abort_Id  : constant Boolean := False;  --  no abort
+   --    Abort_Id  : constant Boolean := False;  --  no abort or For_Package
    --
    --    E_Id      : Exception_Occurrence;
    --    Raised_Id : Boolean := False;
diff --git a/gcc/ada/exp_strm.adb b/gcc/ada/exp_strm.adb
index cc697bf8270..35fcb640529 100644
--- a/gcc/ada/exp_strm.adb
+++ b/gcc/ada/exp_strm.adb
@@ -25,14 +25,11 @@
 
 with Atree;    use Atree;
 with Einfo;    use Einfo;
-with Errout;   use Errout;
 with Exp_Util; use Exp_Util;
 with Namet;    use Namet;
 with Nlists;   use Nlists;
 with Nmake;    use Nmake;
 with Opt;      use Opt;
-with Restrict; use Restrict;
-with Rident;   use Rident;
 with Rtsfind;  use Rtsfind;
 with Sem_Aux;  use Sem_Aux;
 with Sem_Util; use Sem_Util;
@@ -475,18 +472,6 @@ package body Exp_Strm is
       Lib_RE  : RE_Id;
 
    begin
-      Check_Restriction (No_Default_Stream_Attributes, N);
-
-      --  Are we sure following messages are issued in -gnatc mode ???
-
-      if Restriction_Active (No_Default_Stream_Attributes) then
-         Error_Msg_NE
-           ("missing user-defined Input for type&", N, Etype (Targ));
-         if Nkind (Targ) = N_Selected_Component then
-            Error_Msg_NE
-              ("\which is a component of type&", N, Etype (Prefix (Targ)));
-         end if;
-      end if;
 
       --  Check first for Boolean and Character. These are enumeration types,
       --  but we treat them specially, since they may require special handling
@@ -696,16 +681,6 @@ package body Exp_Strm is
       Libent  : Entity_Id;
 
    begin
-      Check_Restriction (No_Default_Stream_Attributes, N);
-
-      if Restriction_Active (No_Default_Stream_Attributes) then
-         Error_Msg_NE
-           ("missing user-defined Write for type&", N, Etype (Item));
-         if Nkind (Item) = N_Selected_Component then
-            Error_Msg_NE
-              ("\which is a component of type&", N, Etype (Prefix (Item)));
-         end if;
-      end if;
 
       --  Compute the size of the stream element. This is either the size of
       --  the first subtype or if given the size of the Stream_Size attribute.
diff --git a/gcc/ada/prj-conf.adb b/gcc/ada/prj-conf.adb
index 1e0e87eab7d..2df66930277 100644
--- a/gcc/ada/prj-conf.adb
+++ b/gcc/ada/prj-conf.adb
@@ -921,10 +921,10 @@ package body Prj.Conf is
          end loop;
 
          declare
-            Obj_Dir  : constant String := Name_Buffer (1 .. Name_Len);
-            Switches : Argument_List_Access := Get_Config_Switches;
-            Args     : Argument_List (1 .. 5);
-            Arg_Last : Positive;
+            Obj_Dir         : constant String := Name_Buffer (1 .. Name_Len);
+            Config_Switches : Argument_List_Access;
+            Args            : Argument_List (1 .. 5);
+            Arg_Last         : Positive;
 
             Obj_Dir_Exists : Boolean := True;
 
@@ -968,6 +968,104 @@ package body Prj.Conf is
                end case;
             end if;
 
+            --  If no switch --RTS have been specified on the command line,
+            --  look for --RTS switches in the Builder switches.
+
+            if RTS_Languages.Get_First = No_Name then
+               declare
+                  Builder : constant Package_Id :=
+                    Value_Of (Name_Builder, Project.Decl.Packages, Shared);
+                  Switch_Array_Id : Array_Element_Id;
+                  Switch_Array : Array_Element;
+
+                  Switch_List   : String_List_Id := Nil_String;
+                  Switch : String_Element;
+
+                  Lang      : Name_Id;
+                  Lang_Last : Positive;
+
+               begin
+                  if Builder /= No_Package then
+                     Switch_Array_Id :=
+                       Value_Of
+                         (Name      => Name_Switches,
+                          In_Arrays =>
+                            Shared.Packages.Table (Builder).Decl.Arrays,
+                          Shared    => Shared);
+
+                     while Switch_Array_Id /= No_Array_Element loop
+                        Switch_Array :=
+                          Shared.Array_Elements.Table (Switch_Array_Id);
+                           Switch_List := Switch_Array.Value.Values;
+
+                        while Switch_List /= Nil_String loop
+                           Switch :=
+                             Shared.String_Elements.Table (Switch_List);
+
+                           if Switch.Value /= No_Name then
+                              Get_Name_String (Switch.Value);
+
+                              if Name_Len >= 7 and then
+                                Name_Buffer (1 .. 5) = "--RTS"
+                              then
+                                 if Name_Buffer (6) = '=' then
+                                    if not Runtime_Name_Set_For (Name_Ada) then
+                                       Set_Runtime_For
+                                         (Name_Ada,
+                                          Name_Buffer (7 .. Name_Len));
+                                    end if;
+
+                                 elsif Name_Len > 7 and then
+                                   Name_Buffer (6) = ':' and then
+                                   Name_Buffer (7) /= '='
+                                 then
+                                    Lang_Last := 7;
+                                    while Lang_Last < Name_Len and then
+                                      Name_Buffer (Lang_Last + 1) /= '='
+                                    loop
+                                       Lang_Last := Lang_Last + 1;
+                                    end loop;
+
+                                    if
+                                      Name_Buffer (Lang_Last + 1) = '='
+                                    then
+                                       declare
+                                          RTS : constant String :=
+                                            Name_Buffer (Lang_Last + 2 ..
+                                                           Name_Len);
+                                       begin
+                                          Name_Buffer (1 .. Lang_Last - 6)
+                                            := Name_Buffer (7 .. Lang_Last);
+                                          Name_Len := Lang_Last - 6;
+                                          To_Lower
+                                            (Name_Buffer (1 .. Name_Len));
+                                          Lang := Name_Find;
+
+                                          if
+                                          not Runtime_Name_Set_For (Lang)
+                                          then
+                                             Set_Runtime_For (Lang, RTS);
+                                          end if;
+                                       end;
+                                    end if;
+                                 end if;
+                              end if;
+                           end if;
+
+                           Switch_List := Switch.Next;
+                        end loop;
+
+                        Switch_Array_Id := Switch_Array.Next;
+                     end loop;
+                  end if;
+               end;
+            end if;
+
+            --  Get the config switches. This should be done only now, as some
+            --  runtimes may have been found if the Builder switches.
+
+            Config_Switches := Get_Config_Switches;
+
             --  Invoke gprconfig
 
             Args (1) := new String'("--batch");
@@ -1041,9 +1139,9 @@ package body Prj.Conf is
                   Write_Str (Args (J).all);
                end loop;
 
-               for J in Switches'Range loop
+               for J in Config_Switches'Range loop
                   Write_Char (' ');
-                  Write_Str (Switches (J).all);
+                  Write_Str (Config_Switches (J).all);
                end loop;
 
                Write_Eol;
@@ -1061,10 +1159,11 @@ package body Prj.Conf is
                end if;
             end if;
 
-            Spawn (Gprconfig_Path.all, Args (1 .. Arg_Last) & Switches.all,
+            Spawn (Gprconfig_Path.all, Args (1 .. Arg_Last) &
+                   Config_Switches.all,
                    Success);
 
-            Free (Switches);
+            Free (Config_Switches);
 
             Config_File_Path := Locate_Config_File (Args (3).all);
 
@@ -1122,6 +1221,15 @@ package body Prj.Conf is
 
             Do_Autoconf;
          end if;
+
+      --  If the config file is not auto-generated, warn if there is any --RTS
+      --  switch on the command line.
+
+      elsif RTS_Languages.Get_First /= No_Name and then
+        Opt.Warning_Mode /= Opt.Suppress
+      then
+         Write_Line
+           ("warning: --RTS is taken into account only in auto-configuration");
       end if;
 
       --  Parse the configuration file
@@ -1405,6 +1513,15 @@ package body Prj.Conf is
       end if;
    end Runtime_Name_For;
 
+   --------------------------
+   -- Runtime_Name_Set_For --
+   --------------------------
+
+   function Runtime_Name_Set_For (Language : Name_Id) return Boolean is
+   begin
+      return RTS_Languages.Get (Language) /= No_Name;
+   end Runtime_Name_Set_For;
+
    ---------------------
    -- Set_Runtime_For --
    ---------------------
diff --git a/gcc/ada/prj-conf.ads b/gcc/ada/prj-conf.ads
index 38e46bef426..977344d455e 100644
--- a/gcc/ada/prj-conf.ads
+++ b/gcc/ada/prj-conf.ads
@@ -186,4 +186,7 @@ package Prj.Conf is
    --  Returns the runtime name for a language. Returns an empty string if no
    --  runtime was specified for the language using option --RTS.
 
+   function Runtime_Name_Set_For (Language : Name_Id) return Boolean;
+   --  Returns True only of Set_Runtime_For has been called for the Language
+
 end Prj.Conf;
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index caf036cda70..0f00423a850 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -1633,6 +1633,39 @@ package body Sem_Attr is
             Check_Restriction (No_Streams, P);
          end if;
 
+         --  AI05-0057: if restriction No_Default_Stream_Attributes is active,
+         --  it is illegal to use a predefined elementary type stream attribute
+         --  either by itself, or more importantly as part of the attribute
+         --  subprogram for a composite type.
+
+         if Restriction_Active (No_Default_Stream_Attributes) then
+            declare
+               T : Entity_Id;
+            begin
+               if Nam = TSS_Stream_Input
+                 or else Nam = TSS_Stream_Read
+               then
+                  T :=
+                    Type_Without_Stream_Operation (P_Type, TSS_Stream_Read);
+               else
+                  T :=
+                    Type_Without_Stream_Operation (P_Type, TSS_Stream_Write);
+               end if;
+
+               if Present (T) then
+                  Check_Restriction (No_Default_Stream_Attributes, N);
+
+                  Error_Msg_NE
+                    ("missing user-defined Stream Read or Write for type&",
+                      N, T);
+                  if not Is_Elementary_Type (P_Type) then
+                     Error_Msg_NE
+                     ("\which is a component of type&", N, P_Type);
+                  end if;
+               end if;
+            end;
+         end if;
+
          --  Check special case of Exception_Id and Exception_Occurrence which
          --  are not allowed for restriction No_Exception_Registration.
 
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index b7b8fe01a6f..47a8c35f68f 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -31,7 +31,6 @@ with Errout;   use Errout;
 with Elists;   use Elists;
 with Exp_Ch11; use Exp_Ch11;
 with Exp_Disp; use Exp_Disp;
-with Exp_Tss;  use Exp_Tss;
 with Exp_Util; use Exp_Util;
 with Fname;    use Fname;
 with Freeze;   use Freeze;
@@ -10784,7 +10783,9 @@ package body Sem_Util is
 
          elsif Is_Record_Type (Btype) then
             Component := First_Entity (Btype);
-            while Present (Component) loop
+            while Present (Component)
+              and then Comes_From_Source (Component)
+            loop
 
                --  Skip anonymous types generated by constrained components
 
@@ -12229,6 +12230,69 @@ package body Sem_Util is
       return Scope_Depth (Enclosing_Dynamic_Scope (Btyp));
    end Type_Access_Level;
 
+   ------------------------------------
+   -- Type_Without_Stream_Operation  --
+   ------------------------------------
+
+   function Type_Without_Stream_Operation
+     (T : Entity_Id; Op : TSS_Name_Type := TSS_Null) return Entity_Id
+   is
+      BT : constant Entity_Id := Base_Type (T);
+      Op_Missing : Boolean;
+   begin
+      if not Restriction_Active (No_Default_Stream_Attributes) then
+         return Empty;
+      end if;
+
+      if Is_Elementary_Type (T) then
+         if Op = TSS_Null then
+            Op_Missing :=
+            No (TSS (BT, TSS_Stream_Read))
+              or else No (TSS (BT, TSS_Stream_Write));
+
+         else
+            Op_Missing := No (TSS (BT, Op));
+         end if;
+
+         if Op_Missing then
+            return T;
+
+         else
+            return Empty;
+         end if;
+
+      elsif Is_Array_Type (T) then
+         return Type_Without_Stream_Operation (Component_Type (T), Op);
+
+      elsif Is_Record_Type (T) then
+         declare
+            Comp  : Entity_Id;
+            C_Typ : Entity_Id;
+
+         begin
+            Comp := First_Component (T);
+            while Present (Comp) loop
+               C_Typ := Type_Without_Stream_Operation (Etype (Comp), Op);
+               if Present (C_Typ) then
+                  return C_Typ;
+               end if;
+
+               Next_Component (Comp);
+            end loop;
+
+            return Empty;
+         end;
+
+      elsif Is_Private_Type (T)
+        and then Present (Full_View (T))
+      then
+         return Type_Without_Stream_Operation (Full_View (T), Op);
+
+      else
+         return Empty;
+      end if;
+   end Type_Without_Stream_Operation;
+
    ----------------------------
    -- Unique_Defining_Entity --
    ----------------------------
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index 5078b3a23c7..ae04cc44e4c 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -26,6 +26,7 @@
 --  Package containing utility procedures used throughout the semantics
 
 with Einfo;  use Einfo;
+with Exp_Tss; use Exp_Tss;
 with Namet;  use Namet;
 with Nmake;  use Nmake;
 with Snames; use Snames;
@@ -1377,6 +1378,16 @@ package Sem_Util is
    function Type_Access_Level (Typ : Entity_Id) return Uint;
    --  Return the accessibility level of Typ
 
+   function Type_Without_Stream_Operation
+     (T : Entity_Id; Op : TSS_Name_Type := TSS_Null) return Entity_Id;
+   --  AI05-0161 : if the restriction No_Default_Stream_Attributes is active
+   --  then we cannot generate stream subprograms for composite types with
+   --  elementary subcomponents that lack user-defined stream subprograms.
+   --  This predicate determines whether a type has such an elementary
+   --  subcomponent. If Op is TSS_Null, a type that lacks either Read or Write
+   --  prevents the construction of a composite stream operation. If Op is
+   --  specified we check only for the given stream operation.
+
    function Unique_Defining_Entity (N : Node_Id) return Entity_Id;
    --  Return the entity which represents declaration N, so that matching
    --  declaration and body have the same entity.