+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,
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;
-- 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 --
---------------------
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
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
-- 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;
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
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;
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)
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;
-- 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;
else
Choice := First (Discrete_Choices (Alt));
while Present (Choice) loop
- Analyze (Choice);
Kind := Nkind (Choice);
-- Choice is a Range
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
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
-- Only other possibility is an expression
else
- Resolve (Choice, Expected_Type);
Check (Choice, Choice, Choice);
end if;
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;
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;
------------------------------------------
projects / thirdparty / gcc.git / commitdiff
