[multiple changes]

2011-08-31  Yannick Moy  <moy@adacore.com>

	* sem_ch4.adb: Code clean up.

2011-08-31  Yannick Moy  <moy@adacore.com>

	* exp_alfa.adb, exp_alfa.ads: Minor correction of copyright notice.

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

	* exp_ch7.adb (Build_Array_Deep_Procs): Do not generate Deep_Finalize
	and TSS primitive Finalize_Address if finalization is suppressed.
	(Build_Record_Deep_Procs): Do not generate Deep_Finalize and TSS
	primitive Finalize_Address if finalization is suppressed.

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

	* s-mudido-affinity.adb, s-taprop-linux.adb, s-taprop-mingw.adb,
	s-taprop-solaris.adb, s-taprop-vxworks.adb (Set_Task_Affinity): Make
	sure that the underlying task has already been created before trying
	to change its affinity.
	(Set_CPU): Use the term processor instead of CPU, as we do in
	Assign_Task.

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

	* prj-attr.adb: New Compiler attribute Source_File_Switches.
	* prj-nmsc.adb (Process_Compiler): Process attribute
	Source_File_Switches.
	* prj.ads (Language_Config): New name list component
	Name_Source_File_Switches.
	* snames.ads-tmpl (Name_Source_File_Switches): New standard name.

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

	* sem_attr.adb (Analyze_Attribute, case 'Old): If prefix may be a
	discriminated component of an actual, expand at once to prevent
	ouf-of-order references with generated subtypes.

2011-08-31  Yannick Moy  <moy@adacore.com>

	* lib-xref-alfa.adb (Add_Alfa_Xrefs): Do not take into account read
	reference to operator in Alfa xrefs.

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

	* sem_ch12.adb (Freeze_Subprogram_Body): Add code to handle the case
	where the parent instance was frozen before the current instance due to
	the presence of a source body. Update calls to Insert_After_Last_Decl.
	(Insert_After_Last_Decl): Renamed to Insert_Freeze_Node_For_Instance.
	Update the comment which illustrates the purpose of the routine.
	Package instances are now frozen by source bodies which appear after
	the instance. This ensures that entities coming from within the
	instance are available for use in the said bodies.
	(Install_Body): Add code to handle the case where the parent instance
	was frozen before the current instance due to the presence of a source
	body. Update calls to Insert_After_Last_Decl.

From-SVN: r178360

gcc/ada/ChangeLog

+2011-08-31  Yannick Moy  <moy@adacore.com>
+
+	* sem_ch4.adb: Code clean up.
+
+2011-08-31  Yannick Moy  <moy@adacore.com>
+
+	* exp_alfa.adb, exp_alfa.ads: Minor correction of copyright notice.
+
+2011-08-31  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* exp_ch7.adb (Build_Array_Deep_Procs): Do not generate Deep_Finalize
+	and TSS primitive Finalize_Address if finalization is suppressed.
+	(Build_Record_Deep_Procs): Do not generate Deep_Finalize and TSS
+	primitive Finalize_Address if finalization is suppressed.
+
+2011-08-31  Jose Ruiz  <ruiz@adacore.com>
+
+	* s-mudido-affinity.adb, s-taprop-linux.adb, s-taprop-mingw.adb,
+	s-taprop-solaris.adb, s-taprop-vxworks.adb (Set_Task_Affinity): Make
+	sure that the underlying task has already been created before trying
+	to change its affinity.
+	(Set_CPU): Use the term processor instead of CPU, as we do in
+	Assign_Task.
+
+2011-08-31  Vincent Celier  <celier@adacore.com>
+
+	* prj-attr.adb: New Compiler attribute Source_File_Switches.
+	* prj-nmsc.adb (Process_Compiler): Process attribute
+	Source_File_Switches.
+	* prj.ads (Language_Config): New name list component
+	Name_Source_File_Switches.
+	* snames.ads-tmpl (Name_Source_File_Switches): New standard name.
+
+2011-08-31  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_attr.adb (Analyze_Attribute, case 'Old): If prefix may be a
+	discriminated component of an actual, expand at once to prevent
+	ouf-of-order references with generated subtypes.
+
+2011-08-31  Yannick Moy  <moy@adacore.com>
+
+	* lib-xref-alfa.adb (Add_Alfa_Xrefs): Do not take into account read
+	reference to operator in Alfa xrefs.
+
+2011-08-31  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* sem_ch12.adb (Freeze_Subprogram_Body): Add code to handle the case
+	where the parent instance was frozen before the current instance due to
+	the presence of a source body. Update calls to Insert_After_Last_Decl.
+	(Insert_After_Last_Decl): Renamed to Insert_Freeze_Node_For_Instance.
+	Update the comment which illustrates the purpose of the routine.
+	Package instances are now frozen by source bodies which appear after
+	the instance. This ensures that entities coming from within the
+	instance are available for use in the said bodies.
+	(Install_Body): Add code to handle the case where the parent instance
+	was frozen before the current instance due to the presence of a source
+	body. Update calls to Insert_After_Last_Decl.
+
 2011-08-31  Jose Ruiz  <ruiz@adacore.com>
 
 	* s-taprop-linux.adb (Set_Task_Affinity): Avoid the use of anonymous

gcc/ada/exp_alfa.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---             Copyright (C) 2011, Free Software Foundation, Inc.           --
+--          Copyright (C) 1992-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- --

gcc/ada/exp_alfa.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---             Copyright (C) 2011, Free Software Foundation, Inc.           --
+--          Copyright (C) 1992-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- --

gcc/ada/exp_ch7.adb

@@ -434,21 +434,26 @@ package body Exp_Ch7 is
               Stmts => Make_Deep_Array_Body (Adjust_Case, Typ)));
       end if;
 
-      Set_TSS (Typ,
-        Make_Deep_Proc
-          (Prim  => Finalize_Case,
-           Typ   => Typ,
-           Stmts => Make_Deep_Array_Body (Finalize_Case, Typ)));
+      --  Do not generate Deep_Finalize and Finalize_Address if finalization is
+      --  suppressed since these routine will not be used.
 
-      --  Create TSS primitive Finalize_Address for non-VM targets. JVM and
-      --  .NET do not support address arithmetic and unchecked conversions.
-
-      if VM_Target = No_VM then
+      if not Restriction_Active (No_Finalization) then
          Set_TSS (Typ,
            Make_Deep_Proc
-             (Prim  => Address_Case,
+             (Prim  => Finalize_Case,
               Typ   => Typ,
-              Stmts => Make_Deep_Array_Body (Address_Case, Typ)));
+              Stmts => Make_Deep_Array_Body (Finalize_Case, Typ)));
+
+         --  Create TSS primitive Finalize_Address for non-VM targets. JVM and
+         --  .NET do not support address arithmetic and unchecked conversions.
+
+         if VM_Target = No_VM then
+            Set_TSS (Typ,
+              Make_Deep_Proc
+                (Prim  => Address_Case,
+                 Typ   => Typ,
+                 Stmts => Make_Deep_Array_Body (Address_Case, Typ)));
+         end if;
       end if;
    end Build_Array_Deep_Procs;
 
@@ -3090,21 +3095,26 @@ package body Exp_Ch7 is
               Stmts => Make_Deep_Record_Body (Adjust_Case, Typ)));
       end if;
 
-      Set_TSS (Typ,
-        Make_Deep_Proc
-          (Prim  => Finalize_Case,
-           Typ   => Typ,
-           Stmts => Make_Deep_Record_Body (Finalize_Case, Typ)));
+      --  Do not generate Deep_Finalize and Finalize_Address if finalization is
+      --  suppressed since these routine will not be used.
 
-      --  Create TSS primitive Finalize_Address for non-VM targets. JVM and
-      --  .NET do not support address arithmetic and unchecked conversions.
-
-      if VM_Target = No_VM then
+      if not Restriction_Active (No_Finalization) then
          Set_TSS (Typ,
            Make_Deep_Proc
-             (Prim  => Address_Case,
+             (Prim  => Finalize_Case,
               Typ   => Typ,
-              Stmts => Make_Deep_Record_Body (Address_Case, Typ)));
+              Stmts => Make_Deep_Record_Body (Finalize_Case, Typ)));
+
+         --  Create TSS primitive Finalize_Address for non-VM targets. JVM and
+         --  .NET do not support address arithmetic and unchecked conversions.
+
+         if VM_Target = No_VM then
+            Set_TSS (Typ,
+              Make_Deep_Proc
+                (Prim  => Address_Case,
+                 Typ   => Typ,
+                 Stmts => Make_Deep_Record_Body (Address_Case, Typ)));
+         end if;
       end if;
    end Build_Record_Deep_Procs;
 

gcc/ada/lib-xref-alfa.adb

@@ -576,6 +576,11 @@ package body Alfa is
       Eliminate_Before_Sort : declare
          NR : Nat;
 
+         function Is_Alfa_Reference
+           (E   : Entity_Id;
+            Typ : Character) return Boolean;
+         --  Return whether the reference is adequate for this entity
+
          function Is_Alfa_Scope (E : Entity_Id) return Boolean;
          --  Return whether the entity or reference scope is adequate
 
@@ -583,6 +588,25 @@ package body Alfa is
          --  Return True if E is a global constant for which we should ignore
          --  reads in Alfa.
 
+         -----------------------
+         -- Is_Alfa_Reference --
+         -----------------------
+
+         function Is_Alfa_Reference
+           (E   : Entity_Id;
+            Typ : Character) return Boolean is
+         begin
+            --  The only references of interest on callable entities are calls.
+            --  On non-callable entities, the only references of interest are
+            --  reads and writes.
+
+            if Ekind (E) in Overloadable_Kind then
+               return Typ = 's';
+            else
+               return Typ = 'r' or else Typ = 'm';
+            end if;
+         end Is_Alfa_Reference;
+
          -------------------
          -- Is_Alfa_Scope --
          -------------------
@@ -617,6 +641,8 @@ package body Alfa is
               and then Is_Alfa_Scope (Xrefs.Table (Rnums (J)).Ent_Scope)
               and then Is_Alfa_Scope (Xrefs.Table (Rnums (J)).Ref_Scope)
               and then not Is_Global_Constant (Xrefs.Table (Rnums (J)).Ent)
+              and then Is_Alfa_Reference (Xrefs.Table (Rnums (J)).Ent,
+                                          Xrefs.Table (Rnums (J)).Typ)
             then
                Nrefs         := Nrefs + 1;
                Rnums (Nrefs) := Rnums (J);

gcc/ada/prj-attr.adb

@@ -190,6 +190,7 @@ package body Prj.Attr is
    "Latrailing_required_switches#" &
    "Lapic_option#" &
    "Sapath_syntax#" &
+   "Sasource_file_switches#" &
    "Saobject_file_suffix#" &
    "Laobject_file_switches#" &
    "Lamulti_unit_switches#" &

gcc/ada/prj-nmsc.adb

@@ -1470,6 +1470,12 @@ package body Prj.Nmsc is
                                     Element.Value.Location, Project);
                            end;
 
+                        when Name_Source_File_Switches =>
+                           Put (Into_List =>
+                                  Lang_Index.Config.Source_File_Switches,
+                                From_List => Element.Value.Values,
+                                In_Tree   => Data.Tree);
+
                         when Name_Object_File_Suffix =>
                            if Get_Name_String (Element.Value.Value) = "" then
                               Error_Msg

gcc/ada/prj.ads

@@ -447,6 +447,11 @@ package Prj is
       --  Value may be Canonical (Unix style) or Host (host syntax, for example
       --  on VMS for DEC C).
 
+      Source_File_Switches : Name_List_Index := No_Name_List;
+      --  Optional switches to be put before the source file. The source file
+      --  path name is appended to the last switch in the list.
+      --  Example: ("-i", "");
+
       Object_File_Suffix : Name_Id := No_Name;
       --  Optional alternate object file suffix
 
@@ -580,6 +585,7 @@ package Prj is
                            Multi_Unit_Switches          => No_Name_List,
                            Multi_Unit_Object_Separator  => ' ',
                            Path_Syntax                  => Canonical,
+                           Source_File_Switches         => No_Name_List,
                            Object_File_Suffix           => No_Name,
                            Object_File_Switches         => No_Name_List,
                            Compilation_PIC_Option       => No_Name_List,

gcc/ada/s-mudido-affinity.adb

@@ -337,7 +337,7 @@ package body System.Multiprocessors.Dispatching_Domains is
          not Target.Common.Domain (CPU))
       then
          raise Dispatching_Domain_Error with
-           "CPU does not belong to the task's dispatching domain";
+           "processor does not belong to the task's dispatching domain";
       end if;
 
       Unchecked_Set_Affinity (Target.Common.Domain, CPU, Target);

gcc/ada/s-taprop-linux.adb

@@ -38,7 +38,6 @@ pragma Polling (Off);
 --  Turn off polling, we do not want ATC polling to take place during tasking
 --  operations. It causes infinite loops and other problems.
 
-with Ada.Unchecked_Conversion;
 with Ada.Unchecked_Deallocation;
 
 with Interfaces.C;
@@ -113,6 +112,10 @@ package body System.Task_Primitives.Operations is
    Abort_Handler_Installed : Boolean := False;
    --  True if a handler for the abort signal is installed
 
+   Null_Thread_Id : constant pthread_t := pthread_t'Last;
+   --  Constant to indicate that the thread identifier has not yet been
+   --  initialized.
+
    --------------------
    -- Local Packages --
    --------------------
@@ -154,13 +157,8 @@ package body System.Task_Primitives.Operations is
    -- Local Subprograms --
    -----------------------
 
-   subtype unsigned_long is Interfaces.C.unsigned_long;
-
    procedure Abort_Handler (signo : Signal);
 
-   function To_pthread_t is new Ada.Unchecked_Conversion
-     (unsigned_long, System.OS_Interface.pthread_t);
-
    -------------------
    -- Abort_Handler --
    -------------------
@@ -773,7 +771,7 @@ package body System.Task_Primitives.Operations is
       Next_Serial_Number := Next_Serial_Number + 1;
       pragma Assert (Next_Serial_Number /= 0);
 
-      Self_ID.Common.LL.Thread := To_pthread_t (-1);
+      Self_ID.Common.LL.Thread := Null_Thread_Id;
 
       if not Single_Lock then
          Result := pthread_mutex_init (Self_ID.Common.LL.L'Access,
@@ -1363,7 +1361,14 @@ package body System.Task_Primitives.Operations is
       use type System.Multiprocessors.CPU_Range;
 
    begin
-      if pthread_setaffinity_np'Address /= System.Null_Address then
+      --  Do nothing if there is no support for setting affinities or the
+      --  underlying thread has not yet been created. If the thread has not
+      --  yet been created then the proper affinity will be set during its
+      --  creation.
+
+      if pthread_setaffinity_np'Address /= System.Null_Address
+        and then T.Common.LL.Thread /= Null_Thread_Id
+      then
          declare
             type cpu_set_t_ptr is access all cpu_set_t;
 

gcc/ada/s-taprop-mingw.adb

@@ -131,6 +131,10 @@ package body System.Task_Primitives.Operations is
    Annex_D : Boolean := False;
    --  Set to True if running with Annex-D semantics
 
+   Null_Thread_Id : constant Thread_Id := 0;
+   --  Constant to indicate that the thread identifier has not yet been
+   --  initialized.
+
    ------------------------------------
    -- The thread local storage index --
    ------------------------------------
@@ -853,7 +857,7 @@ package body System.Task_Primitives.Operations is
       --  Initialize thread ID to 0, this is needed to detect threads that
       --  are not yet activated.
 
-      Self_ID.Common.LL.Thread := 0;
+      Self_ID.Common.LL.Thread := Null_Thread_Id;
 
       Initialize_Cond (Self_ID.Common.LL.CV'Access);
 
@@ -1362,9 +1366,16 @@ package body System.Task_Primitives.Operations is
       use type System.Multiprocessors.CPU_Range;
 
    begin
+      --  Do nothing if the underlying thread has not yet been created. If the
+      --  thread has not yet been created then the proper affinity will be set
+      --  during its creation.
+
+      if T.Common.LL.Thread = Null_Thread_Id then
+         null;
+
       --  pragma CPU
 
-      if T.Common.Base_CPU /= System.Multiprocessors.Not_A_Specific_CPU then
+      elsif T.Common.Base_CPU /= Multiprocessors.Not_A_Specific_CPU then
 
          --  The CPU numbering in pragma CPU starts at 1 while the subprogram
          --  to set the affinity starts at 0, therefore we must substract 1.

gcc/ada/s-taprop-solaris.adb

@@ -101,6 +101,10 @@ package body System.Task_Primitives.Operations is
    Abort_Handler_Installed : Boolean := False;
    --  True if a handler for the abort signal is installed
 
+   Null_Thread_Id : constant Thread_Id := Thread_Id'Last;
+   --  Constant to indicate that the thread identifier has not yet been
+   --  initialized.
+
    ----------------------
    -- Priority Support --
    ----------------------
@@ -917,7 +921,7 @@ package body System.Task_Primitives.Operations is
       Next_Serial_Number := Next_Serial_Number + 1;
       pragma Assert (Next_Serial_Number /= 0);
 
-      Self_ID.Common.LL.Thread := To_thread_t (-1);
+      Self_ID.Common.LL.Thread := Null_Thread_Id;
 
       if not Single_Lock then
          Result :=
@@ -1021,7 +1025,7 @@ package body System.Task_Primitives.Operations is
         Ada.Unchecked_Deallocation (Ada_Task_Control_Block, Task_Id);
 
    begin
-      T.Common.LL.Thread := To_thread_t (0);
+      T.Common.LL.Thread := Null_Thread_Id;
 
       if not Single_Lock then
          Result := mutex_destroy (T.Common.LL.L.L'Access);
@@ -1944,9 +1948,16 @@ package body System.Task_Primitives.Operations is
       use type System.Multiprocessors.CPU_Range;
 
    begin
+      --  Do nothing if the underlying thread has not yet been created. If the
+      --  thread has not yet been created then the proper affinity will be set
+      --  during its creation.
+
+      if T.Common.LL.Thread = Null_Thread_Id then
+         null;
+
       --  pragma CPU
 
-      if T.Common.Base_CPU /=
+      elsif T.Common.Base_CPU /=
            System.Multiprocessors.Not_A_Specific_CPU
       then
          --  The CPU numbering in pragma CPU starts at 1 while the subprogram

gcc/ada/s-taprop-vxworks.adb

@@ -105,6 +105,10 @@ package body System.Task_Primitives.Operations is
    Time_Slice_Val : Integer;
    pragma Import (C, Time_Slice_Val, "__gl_time_slice_val");
 
+   Null_Thread_Id : constant Thread_Id := 0;
+   --  Constant to indicate that the thread identifier has not yet been
+   --  initialized.
+
    --------------------
    -- Local Packages --
    --------------------
@@ -859,7 +863,7 @@ package body System.Task_Primitives.Operations is
    procedure Initialize_TCB (Self_ID : Task_Id; Succeeded : out Boolean) is
    begin
       Self_ID.Common.LL.CV := semBCreate (SEM_Q_PRIORITY, SEM_EMPTY);
-      Self_ID.Common.LL.Thread := 0;
+      Self_ID.Common.LL.Thread := Null_Thread_Id;
 
       if Self_ID.Common.LL.CV = 0 then
          Succeeded := False;
@@ -952,7 +956,7 @@ package body System.Task_Primitives.Operations is
 
       Set_Task_Affinity (T);
 
-      if T.Common.LL.Thread <= 0 then
+      if T.Common.LL.Thread <= Null_Thread_Id then
          Succeeded := False;
       else
          Succeeded := True;
@@ -979,7 +983,7 @@ package body System.Task_Primitives.Operations is
          pragma Assert (Result = 0);
       end if;
 
-      T.Common.LL.Thread := 0;
+      T.Common.LL.Thread := Null_Thread_Id;
 
       Result := semDelete (T.Common.LL.CV);
       pragma Assert (Result = 0);
@@ -1254,7 +1258,7 @@ package body System.Task_Primitives.Operations is
       Thread_Self : Thread_Id) return Boolean
    is
    begin
-      if T.Common.LL.Thread /= 0
+      if T.Common.LL.Thread /= Null_Thread_Id
         and then T.Common.LL.Thread /= Thread_Self
       then
          return taskSuspend (T.Common.LL.Thread) = 0;
@@ -1272,7 +1276,7 @@ package body System.Task_Primitives.Operations is
       Thread_Self : Thread_Id) return Boolean
    is
    begin
-      if T.Common.LL.Thread /= 0
+      if T.Common.LL.Thread /= Null_Thread_Id
         and then T.Common.LL.Thread /= Thread_Self
       then
          return taskResume (T.Common.LL.Thread) = 0;
@@ -1298,7 +1302,7 @@ package body System.Task_Primitives.Operations is
 
       C := All_Tasks_List;
       while C /= null loop
-         if C.Common.LL.Thread /= 0
+         if C.Common.LL.Thread /= Null_Thread_Id
            and then C.Common.LL.Thread /= Thread_Self
          then
             Dummy := Task_Stop (C.Common.LL.Thread);
@@ -1316,7 +1320,7 @@ package body System.Task_Primitives.Operations is
 
    function Stop_Task (T : ST.Task_Id) return Boolean is
    begin
-      if T.Common.LL.Thread /= 0 then
+      if T.Common.LL.Thread /= Null_Thread_Id then
          return Task_Stop (T.Common.LL.Thread) = 0;
       else
          return True;
@@ -1330,7 +1334,7 @@ package body System.Task_Primitives.Operations is
    function Continue_Task (T : ST.Task_Id) return Boolean
    is
    begin
-      if T.Common.LL.Thread /= 0 then
+      if T.Common.LL.Thread /= Null_Thread_Id then
          return Task_Cont (T.Common.LL.Thread) = 0;
       else
          return True;
@@ -1408,9 +1412,16 @@ package body System.Task_Primitives.Operations is
       use type System.Multiprocessors.CPU_Range;
 
    begin
+      --  Do nothing if the underlying thread has not yet been created. If the
+      --  thread has not yet been created then the proper affinity will be set
+      --  during its creation.
+
+      if T.Common.LL.Thread = Null_Thread_Id then
+         null;
+
       --  pragma CPU
 
-      if T.Common.Base_CPU /= System.Multiprocessors.Not_A_Specific_CPU then
+      elsif T.Common.Base_CPU /= Multiprocessors.Not_A_Specific_CPU then
 
          --  Ada 2012 pragma CPU uses CPU numbers starting from 1, while on
          --  VxWorks the first CPU is identified by a 0, so we need to adjust.

gcc/ada/sem_attr.adb

@@ -1939,7 +1939,7 @@ package body Sem_Attr is
       --  Analyze prefix and exit if error in analysis. If the prefix is an
       --  incomplete type, use full view if available. Note that there are
       --  some attributes for which we do not analyze the prefix, since the
-      --  prefix is not a normal name.
+      --  prefix is not a normal name, or else needs special handling.
 
       if Aname /= Name_Elab_Body
            and then
@@ -1950,6 +1950,8 @@ package body Sem_Attr is
          Aname /= Name_UET_Address
            and then
          Aname /= Name_Enabled
+           and then
+         Aname /= Name_Old
       then
          Analyze (P);
          P_Type := Etype (P);
@@ -3772,6 +3774,12 @@ package body Sem_Attr is
          end if;
 
          Check_E0;
+
+         --  Prefix has not been analyzed yet, and its full analysis will take
+         --  place during expansion (see below).
+
+         Preanalyze_And_Resolve (P);
+         P_Type := Etype (P);
          Set_Etype (N, P_Type);
 
          if No (Current_Subprogram) then
@@ -3852,6 +3860,24 @@ package body Sem_Attr is
             end if;
          end Check_Local;
 
+         --  The attribute ppears within a pre/postcondition, but refers to
+         --  an entity in the enclosing subprogram. If it is a component of a
+         --  formal its expansion might generate actual subtypes that may be
+         --  referenced in an inner context, and which must be elaborated
+         --  within the subprogram itself. As a result we create a declaration
+         --  for it and insert it at the start of the enclosing subprogram
+         --  This is properly an expansion activity but it has to be performed
+         --  now to prevent out-of-order issues.
+
+         if Nkind (P) = N_Selected_Component
+           and then Has_Discriminants (Etype (Prefix (P)))
+         then
+            P_Type := Base_Type (P_Type);
+            Set_Etype (N, P_Type);
+            Set_Etype (P, P_Type);
+            Expand (N);
+         end if;
+
       ------------
       -- Output --
       ------------

gcc/ada/sem_ch4.adb

@@ -3357,10 +3357,12 @@ package body Sem_Ch4 is
 
       Check_SPARK_Restriction ("quantified expression is not allowed", N);
 
-      --  If expansion is enabled, the condition is analyzed after rewritten
-      --  as a loop. Otherwise we only need to set the type.
+      --  If expansion is enabled (and not in Alfa mode), the condition is
+      --  analyzed after rewritten as a loop. So we only need to set the type.
 
-      if Operating_Mode /= Check_Semantics then
+      if Operating_Mode /= Check_Semantics
+        and then not Alfa_Mode
+      then
          Set_Etype (N, Standard_Boolean);
          return;
       end if;

gcc/ada/snames.ads-tmpl

@@ -1193,6 +1193,7 @@ package Snames is
    Name_Shared_Library_Suffix            : constant Name_Id := N + $;
    Name_Separate_Suffix                  : constant Name_Id := N + $;
    Name_Source_Dirs                      : constant Name_Id := N + $;
+   Name_Source_File_Switches             : constant Name_Id := N + $;
    Name_Source_Files                     : constant Name_Id := N + $;
    Name_Source_List_File                 : constant Name_Id := N + $;
    Name_Spec                             : constant Name_Id := N + $;