[multiple changes]

2013-10-10  Thomas Quinot  <quinot@adacore.com>

	* s-taprop-posix.adb: Add missing comment.

2013-10-10  Robert Dewar  <dewar@adacore.com>

	* freeze.adb (Freeze_Record_Type): Move choice checking to
	Analyze_Freeze_Entity (Freeze_Record_Type): Make sure all choices
	are properly frozen
	* sem_case.adb (Check_Choices): Remove misguided attempt to
	freeze choices (this is now done in Freeze_Record_Type where
	it belongs).
	(Check_Choices): Remove some analyze/resolve calls
	that are redundant since they are done in Analyze_Choices.
	* sem_ch13.adb (Analyze_Freeze_Entity): Do the error
	checking for choices in variant records here (moved here from
	Freeze.Freeze_Record_Type)

From-SVN: r203364

gcc/ada/ChangeLog

 2013-10-10  Thomas Quinot  <quinot@adacore.com>
 
+	* s-taprop-posix.adb: Add missing comment.
+
+2013-10-10  Robert Dewar  <dewar@adacore.com>
+
+	* freeze.adb (Freeze_Record_Type): Move choice checking to
+	Analyze_Freeze_Entity (Freeze_Record_Type): Make sure all choices
+	are properly frozen
+	* sem_case.adb (Check_Choices): Remove misguided attempt to
+	freeze choices (this is now done in Freeze_Record_Type where
+	it belongs).
+	(Check_Choices): Remove some analyze/resolve calls
+	that are redundant since they are done in Analyze_Choices.
+	* sem_ch13.adb (Analyze_Freeze_Entity): Do the error
+	checking for choices in variant records here (moved here from
+	Freeze.Freeze_Record_Type)
+
+2013-10-10  Thomas Quinot  <quinot@adacore.com>
+
 	* s-oscons-tmplt.c, s-taprop-posix.adb (CLOCK_REALTIME): Always define,
 	possibly using a dummy placeholder value.
 	(Compute_Deadline): For the case of an

gcc/ada/freeze.adb

@@ -46,7 +46,6 @@ with Rident;   use Rident;
 with Rtsfind;  use Rtsfind;
 with Sem;      use Sem;
 with Sem_Aux;  use Sem_Aux;
-with Sem_Case; use Sem_Case;
 with Sem_Cat;  use Sem_Cat;
 with Sem_Ch6;  use Sem_Ch6;
 with Sem_Ch7;  use Sem_Ch7;
@@ -1995,6 +1994,11 @@ package body Freeze is
          --  freeze node at some eventual point of call. Protected operations
          --  are handled elsewhere.
 
+         procedure Freeze_Choices_In_Variant_Part (VP : Node_Id);
+         --  Make sure that all types mentioned in Discrete_Choices of the
+         --  variants referenceed by the Variant_Part VP are frozen. This is
+         --  a recursive routine to deal with nested variants.
+
          ---------------------
          -- Check_Allocator --
          ---------------------
@@ -2047,6 +2051,50 @@ package body Freeze is
             end if;
          end Check_Itype;
 
+         ------------------------------------
+         -- Freeze_Choices_In_Variant_Part --
+         ------------------------------------
+
+         procedure Freeze_Choices_In_Variant_Part (VP : Node_Id) is
+            pragma Assert (Nkind (VP) = N_Variant_Part);
+
+            Variant : Node_Id;
+            Choice  : Node_Id;
+            CL      : Node_Id;
+
+         begin
+            --  Loop through variants
+
+            Variant := First_Non_Pragma (Variants (VP));
+            while Present (Variant) loop
+
+               --  Loop through choices, checking that all types are frozen
+
+               Choice := First_Non_Pragma (Discrete_Choices (Variant));
+               while Present (Choice) loop
+                  if Nkind (Choice) in N_Has_Etype
+                    and then Present (Etype (Choice))
+                  then
+                     Freeze_And_Append (Etype (Choice), N, Result);
+                  end if;
+
+                  Next_Non_Pragma (Choice);
+               end loop;
+
+               --  Check for nested variant part to process
+
+               CL := Component_List (Variant);
+
+               if not Null_Present (CL) then
+                  if Present (Variant_Part (CL)) then
+                     Freeze_Choices_In_Variant_Part (Variant_Part (CL));
+                  end if;
+               end if;
+
+               Next_Non_Pragma (Variant);
+            end loop;
+         end Freeze_Choices_In_Variant_Part;
+
       --  Start of processing for Freeze_Record_Type
 
       begin
@@ -2627,108 +2675,14 @@ package body Freeze is
             return;
          end if;
 
-         --  Finallly we need to check the variant part to make sure that
-         --  the set of choices for each variant covers the corresponding
-         --  discriminant. This check has to be delayed to the freeze point
-         --  because we may have statically predicated subtypes, whose choice
-         --  list is not known till the subtype is frozen.
+         --  Finally we need to check the variant part to make sure that
+         --  all types within choices are properly frozen as part of the
+         --  freezing of the record type.
 
          Check_Variant_Part : declare
             D : constant Node_Id := Declaration_Node (Rec);
             T : Node_Id;
             C : Node_Id;
-            V : Node_Id;
-
-            Others_Present : Boolean;
-            pragma Warnings (Off, Others_Present);
-            --  Indicates others present, not used in this case
-
-            procedure Non_Static_Choice_Error (Choice : Node_Id);
-            --  Error routine invoked by the generic instantiation below when
-            --  the variant part has a non static choice.
-
-            procedure Process_Declarations (Variant : Node_Id);
-            --  Processes declarations associated with a variant. We analyzed
-            --  the declarations earlier (in Sem_Ch3.Analyze_Variant_Part),
-            --  but we still need the recursive call to Check_Choices for any
-            --  nested variant to get its choices properly processed. This is
-            --  also where we expand out the choices if expansion is active.
-
-            package Variant_Choices_Processing is new
-              Generic_Check_Choices
-                (Process_Empty_Choice      => No_OP,
-                 Process_Non_Static_Choice => Non_Static_Choice_Error,
-                 Process_Associated_Node   => Process_Declarations);
-            use Variant_Choices_Processing;
-
-            -----------------------------
-            -- Non_Static_Choice_Error --
-            -----------------------------
-
-            procedure Non_Static_Choice_Error (Choice : Node_Id) is
-            begin
-               Flag_Non_Static_Expr
-                 ("choice given in variant part is not static!", Choice);
-            end Non_Static_Choice_Error;
-
-            --------------------------
-            -- Process_Declarations --
-            --------------------------
-
-            procedure Process_Declarations (Variant : Node_Id) is
-               CL : constant Node_Id := Component_List (Variant);
-               VP : Node_Id;
-
-            begin
-               --  Check for static predicate present in this variant
-
-               if Has_SP_Choice (Variant) then
-
-                  --  Here we expand. You might expect to find this call in
-                  --  Expand_N_Variant_Part, but that is called when we first
-                  --  see the variant part, and we cannot do this expansion
-                  --  earlier than the freeze point, since for statically
-                  --  predicated subtypes, the predicate is not known till
-                  --  the freeze point.
-
-                  --  Furthermore, we do this expansion even if the expander
-                  --  is not active, because other semantic processing, e.g.
-                  --  for aggregates, requires the expanded list of choices.
-
-                  --  If the expander is not active, then we can't just clobber
-                  --  the list since it would invalidate the ASIS -gnatct tree.
-                  --  So we have to rewrite the variant part with a Rewrite
-                  --  call that replaces it with a copy and clobber the copy.
-
-                  if not Expander_Active then
-                     declare
-                        NewV : constant Node_Id := New_Copy (Variant);
-                     begin
-                        Set_Discrete_Choices
-                          (NewV, New_Copy_List (Discrete_Choices (Variant)));
-                        Rewrite (Variant, NewV);
-                     end;
-                  end if;
-
-                  Expand_Static_Predicates_In_Choices (Variant);
-               end if;
-
-               --  We don't need to worry about the declarations in the variant
-               --  (since they were analyzed by Analyze_Choices when we first
-               --  encountered the variant), but we do need to take care of
-               --  expansion of any nested variants.
-
-               if not Null_Present (CL) then
-                  VP := Variant_Part (CL);
-
-                  if Present (VP) then
-                     Check_Choices
-                       (VP, Variants (VP), Etype (Name (VP)), Others_Present);
-                  end if;
-               end if;
-            end Process_Declarations;
-
-         --  Start of processing for Check_Variant_Part
 
          begin
             --  Find component list
@@ -2751,44 +2705,15 @@ package body Freeze is
             --  Case of variant part present
 
             if Present (C) and then Present (Variant_Part (C)) then
-               V := Variant_Part (C);
-
-               --  Check choices
-
-               Check_Choices
-                 (V, Variants (V), Etype (Name (V)), Others_Present);
-
-               --  If the last variant does not contain the Others choice,
-               --  replace it with an N_Others_Choice node since Gigi always
-               --  wants an Others. Note that we do not bother to call Analyze
-               --  on the modified variant part, since its only effect would be
-               --  to compute the Others_Discrete_Choices node laboriously, and
-               --  of course we already know the list of choices corresponding
-               --  to the others choice (it's the list we're replacing!)
-
-               --  We only want to do this if the expander is active, since
-               --  we do not want to clobber the ASIS tree!
-
-               if Expander_Active then
-                  declare
-                     Last_Var : constant Node_Id :=
-                                     Last_Non_Pragma (Variants (V));
+               Freeze_Choices_In_Variant_Part (Variant_Part (C));
+            end if;
 
-                     Others_Node : Node_Id;
+            --  Note: we used to call Check_Choices here, but it is too early,
+            --  since predicated subtypes are frozen here, but their freezing
+            --  actions are in Analyze_Freeze_Entity, which has not been called
+            --  yet for entities frozen within this procedure, so we moved that
+            --  call to the Analyze_Freeze_Entity for the record type.
 
-                  begin
-                     if Nkind (First (Discrete_Choices (Last_Var))) /=
-                                                            N_Others_Choice
-                     then
-                        Others_Node := Make_Others_Choice (Sloc (Last_Var));
-                        Set_Others_Discrete_Choices
-                          (Others_Node, Discrete_Choices (Last_Var));
-                        Set_Discrete_Choices
-                          (Last_Var, New_List (Others_Node));
-                     end if;
-                  end;
-               end if;
-            end if;
          end Check_Variant_Part;
       end Freeze_Record_Type;
 

gcc/ada/s-taprop-posix.adb

@@ -183,7 +183,7 @@ package body System.Task_Primitives.Operations is
       Mode       : ST.Delay_Modes;
       Check_Time : out Duration;
       Abs_Time   : out Duration;
-      Rel_time   : out Duration);
+      Rel_Time   : out Duration);
    --  Helper for Timed_Sleep and Timed_Delay: given a deadline specified by
    --  Time and Mode, compute the current clock reading (Check_Time), and the
    --  target absolute and relative clock readings (Abs_Time, Rel_Time). The
@@ -257,7 +257,7 @@ package body System.Task_Primitives.Operations is
       Mode       : ST.Delay_Modes;
       Check_Time : out Duration;
       Abs_Time   : out Duration;
-      Rel_time   : out Duration)
+      Rel_Time   : out Duration)
    is
    begin
       Check_Time := Monotonic_Clock;
@@ -272,7 +272,8 @@ package body System.Task_Primitives.Operations is
          end if;
 
          pragma Warnings (Off);
-         --  Must comment a pragma Warnings (Off) to say why ???
+         --  Comparison "OSC.CLOCK_RT_Ada = OSC.CLOCK_REALTIME" is compile
+         --  time known.
 
       --  Absolute deadline specified using the tasking clock (CLOCK_RT_Ada)
 

gcc/ada/sem_case.adb

@@ -26,8 +26,6 @@
 with Atree;    use Atree;
 with Einfo;    use Einfo;
 with Errout;   use Errout;
-with Exp_Util; use Exp_Util;
-with Freeze;   use Freeze;
 with Namet;    use Namet;
 with Nlists;   use Nlists;
 with Nmake;    use Nmake;
@@ -1297,9 +1295,7 @@ package body Sem_Case is
          --  then don't try any semantic checking on the choices since we have
          --  a complete mess.
 
-         if not Is_Discrete_Type (Subtyp)
-           or else Subtyp = Any_Type
-         then
+         if not Is_Discrete_Type (Subtyp) or else Subtyp = Any_Type then
             return;
          end if;
 
@@ -1357,7 +1353,6 @@ package body Sem_Case is
             else
                Choice := First (Discrete_Choices (Alt));
                while Present (Choice) loop
-                  Analyze (Choice);
                   Kind := Nkind (Choice);
 
                   --  Choice is a Range
@@ -1366,7 +1361,6 @@ package body Sem_Case is
                     or else (Kind = N_Attribute_Reference
                               and then Attribute_Name (Choice) = Name_Range)
                   then
-                     Resolve (Choice, Expected_Type);
                      Check (Choice, Low_Bound (Choice), High_Bound (Choice));
 
                   --  Choice is a subtype name
@@ -1374,12 +1368,6 @@ package body Sem_Case is
                   elsif Is_Entity_Name (Choice)
                     and then Is_Type (Entity (Choice))
                   then
-                     --  We have to make sure the subtype is frozen, it must be
-                     --  before we can do the following analyses on choices!
-
-                     Insert_Actions
-                       (N, Freeze_Entity (Entity (Choice), Choice));
-
                      --  Check for inappropriate type
 
                      if not Covers (Expected_Type, Etype (Choice)) then
@@ -1505,7 +1493,6 @@ package body Sem_Case is
                   --  Only other possibility is an expression
 
                   else
-                     Resolve (Choice, Expected_Type);
                      Check (Choice, Choice, Choice);
                   end if;
 

gcc/ada/sem_ch13.adb

@@ -44,6 +44,7 @@ with Rident;   use Rident;
 with Rtsfind;  use Rtsfind;
 with Sem;      use Sem;
 with Sem_Aux;  use Sem_Aux;
+with Sem_Case; use Sem_Case;
 with Sem_Ch3;  use Sem_Ch3;
 with Sem_Ch6;  use Sem_Ch6;
 with Sem_Ch8;  use Sem_Ch8;
@@ -5239,6 +5240,171 @@ package body Sem_Ch13 is
 
          Uninstall_Discriminants_And_Pop_Scope (E);
       end if;
+
+      --  For a record type, deal with variant parts. This has to be delayed
+      --  to this point, because of the issue of statically precicated
+      --  subtypes, which we have to ensure are frozen before checking
+      --  choices, since we need to have the static choice list set.
+
+      if Is_Record_Type (E) then
+         Check_Variant_Part : declare
+            D  : constant Node_Id := Declaration_Node (E);
+            T  : Node_Id;
+            C  : Node_Id;
+            VP : Node_Id;
+
+            Others_Present : Boolean;
+            pragma Warnings (Off, Others_Present);
+            --  Indicates others present, not used in this case
+
+            procedure Non_Static_Choice_Error (Choice : Node_Id);
+            --  Error routine invoked by the generic instantiation below when
+            --  the variant part has a non static choice.
+
+            procedure Process_Declarations (Variant : Node_Id);
+            --  Processes declarations associated with a variant. We analyzed
+            --  the declarations earlier (in Sem_Ch3.Analyze_Variant_Part),
+            --  but we still need the recursive call to Check_Choices for any
+            --  nested variant to get its choices properly processed. This is
+            --  also where we expand out the choices if expansion is active.
+
+            package Variant_Choices_Processing is new
+              Generic_Check_Choices
+                (Process_Empty_Choice      => No_OP,
+                 Process_Non_Static_Choice => Non_Static_Choice_Error,
+                 Process_Associated_Node   => Process_Declarations);
+            use Variant_Choices_Processing;
+
+            -----------------------------
+            -- Non_Static_Choice_Error --
+            -----------------------------
+
+            procedure Non_Static_Choice_Error (Choice : Node_Id) is
+            begin
+               Flag_Non_Static_Expr
+                 ("choice given in variant part is not static!", Choice);
+            end Non_Static_Choice_Error;
+
+            --------------------------
+            -- Process_Declarations --
+            --------------------------
+
+            procedure Process_Declarations (Variant : Node_Id) is
+               CL : constant Node_Id := Component_List (Variant);
+               VP : Node_Id;
+
+            begin
+               --  Check for static predicate present in this variant
+
+               if Has_SP_Choice (Variant) then
+
+                  --  Here we expand. You might expect to find this call in
+                  --  Expand_N_Variant_Part, but that is called when we first
+                  --  see the variant part, and we cannot do this expansion
+                  --  earlier than the freeze point, since for statically
+                  --  predicated subtypes, the predicate is not known till
+                  --  the freeze point.
+
+                  --  Furthermore, we do this expansion even if the expander
+                  --  is not active, because other semantic processing, e.g.
+                  --  for aggregates, requires the expanded list of choices.
+
+                  --  If the expander is not active, then we can't just clobber
+                  --  the list since it would invalidate the ASIS -gnatct tree.
+                  --  So we have to rewrite the variant part with a Rewrite
+                  --  call that replaces it with a copy and clobber the copy.
+
+                  if not Expander_Active then
+                     declare
+                        NewV : constant Node_Id := New_Copy (Variant);
+                     begin
+                        Set_Discrete_Choices
+                          (NewV, New_Copy_List (Discrete_Choices (Variant)));
+                        Rewrite (Variant, NewV);
+                     end;
+                  end if;
+
+                  Expand_Static_Predicates_In_Choices (Variant);
+               end if;
+
+               --  We don't need to worry about the declarations in the variant
+               --  (since they were analyzed by Analyze_Choices when we first
+               --  encountered the variant), but we do need to take care of
+               --  expansion of any nested variants.
+
+               if not Null_Present (CL) then
+                  VP := Variant_Part (CL);
+
+                  if Present (VP) then
+                     Check_Choices
+                       (VP, Variants (VP), Etype (Name (VP)), Others_Present);
+                  end if;
+               end if;
+            end Process_Declarations;
+
+         --  Start of processing for Check_Variant_Part
+
+         begin
+            --  Find component list
+
+            C := Empty;
+
+            if Nkind (D) = N_Full_Type_Declaration then
+               T := Type_Definition (D);
+
+               if Nkind (T) = N_Record_Definition then
+                  C := Component_List (T);
+
+               elsif Nkind (T) = N_Derived_Type_Definition
+                 and then Present (Record_Extension_Part (T))
+               then
+                  C := Component_List (Record_Extension_Part (T));
+               end if;
+            end if;
+
+            --  Case of variant part present
+
+            if Present (C) and then Present (Variant_Part (C)) then
+               VP := Variant_Part (C);
+
+               --  Check choices
+
+               Check_Choices
+                 (VP, Variants (VP), Etype (Name (VP)), Others_Present);
+
+               --  If the last variant does not contain the Others choice,
+               --  replace it with an N_Others_Choice node since Gigi always
+               --  wants an Others. Note that we do not bother to call Analyze
+               --  on the modified variant part, since its only effect would be
+               --  to compute the Others_Discrete_Choices node laboriously, and
+               --  of course we already know the list of choices corresponding
+               --  to the others choice (it's the list we're replacing!)
+
+               --  We only want to do this if the expander is active, since
+               --  we do not want to clobber the ASIS tree!
+
+               if Expander_Active then
+                  declare
+                     Last_Var : constant Node_Id :=
+                                     Last_Non_Pragma (Variants (VP));
+
+                     Others_Node : Node_Id;
+
+                  begin
+                     if Nkind (First (Discrete_Choices (Last_Var))) /=
+                                                            N_Others_Choice
+                     then
+                        Others_Node := Make_Others_Choice (Sloc (Last_Var));
+                        Set_Others_Discrete_Choices
+                          (Others_Node, Discrete_Choices (Last_Var));
+                        Set_Discrete_Choices
+                          (Last_Var, New_List (Others_Node));
+                     end if;
+                  end;
+               end if;
+            end if;
+         end Check_Variant_Part;
+      end if;
    end Analyze_Freeze_Entity;
 
    ------------------------------------------