diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/ChangeLog | 18 | ||||
| -rw-r--r-- | gcc/ada/freeze.adb | 193 | ||||
| -rw-r--r-- | gcc/ada/s-taprop-posix.adb | 7 | ||||
| -rw-r--r-- | gcc/ada/sem_case.adb | 15 | ||||
| -rw-r--r-- | gcc/ada/sem_ch13.adb | 166 |
5 files changed, 248 insertions, 151 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 8936328..1526c73 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,23 @@ 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 diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 79b0a0d..7a79d8e 100644 --- a/gcc/ada/freeze.adb +++ b/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; diff --git a/gcc/ada/s-taprop-posix.adb b/gcc/ada/s-taprop-posix.adb index cf45eb4..c7747ab 100644 --- a/gcc/ada/s-taprop-posix.adb +++ b/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) diff --git a/gcc/ada/sem_case.adb b/gcc/ada/sem_case.adb index 6701776..919ac8d 100644 --- a/gcc/ada/sem_case.adb +++ b/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; diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 8f7f246..e307e87 100644 --- a/gcc/ada/sem_ch13.adb +++ b/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; ------------------------------------------ |