diff options
Diffstat (limited to 'gcc/ada')
| -rw-r--r-- | gcc/ada/ChangeLog | 16 | ||||
| -rwxr-xr-x | gcc/ada/aspects.adb | 2 | ||||
| -rwxr-xr-x | gcc/ada/aspects.ads | 6 | ||||
| -rw-r--r-- | gcc/ada/expander.adb | 1 | ||||
| -rw-r--r-- | gcc/ada/sem_ch13.adb | 51 | ||||
| -rw-r--r-- | gcc/ada/sinfo.adb | 32 | ||||
| -rw-r--r-- | gcc/ada/sinfo.ads | 40 | ||||
| -rw-r--r-- | gcc/ada/snames.ads-tmpl | 2 | ||||
| -rw-r--r-- | gcc/ada/usage.adb | 16 |
9 files changed, 142 insertions, 24 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 270f419..86eb2bc 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,21 @@ 2011-08-01 Robert Dewar <dewar@adacore.com> + * aspects.ads, aspects.adb: Add Static_Predicate and Dynamic_Predicate. + * sem_ch13.adb (Analyze_Aspect_Specification): Add processing for + Static_Predicate and Dynamic_Predicate. + (Build_Predicate_Function): Add processing for Static_Predicate + and Dynamic_Predicate. + * sinfo.ads, sinfo.adb (From_Dynamic_Predicate): New flag + (From_Static_Predicate): New flag + * snames.ads-tmpl: Add Name_Static_Predicate and Name_Dynamic_Predicate + +2011-08-01 Robert Dewar <dewar@adacore.com> + + * usage.adb: Documentation cleanup for Ada version modes in usage. + * expander.adb: Minor reformatting. + +2011-08-01 Robert Dewar <dewar@adacore.com> + * atree.ads: Minor comment fix. * a-stwifi.adb, a-stzfix.adb, a-strfix.adb, a-ztexio.ads, a-textio.ads, a-witeio.ads, sem_prag.adb: Minor reformatting. diff --git a/gcc/ada/aspects.adb b/gcc/ada/aspects.adb index faf50cd..ab6b454 100755 --- a/gcc/ada/aspects.adb +++ b/gcc/ada/aspects.adb @@ -81,6 +81,7 @@ package body Aspects is (Name_Atomic_Components, Aspect_Atomic_Components), (Name_Bit_Order, Aspect_Bit_Order), (Name_Component_Size, Aspect_Component_Size), + (Name_Dynamic_Predicate, Aspect_Dynamic_Predicate), (Name_Discard_Names, Aspect_Discard_Names), (Name_External_Tag, Aspect_External_Tag), (Name_Favor_Top_Level, Aspect_Favor_Top_Level), @@ -101,6 +102,7 @@ package body Aspects is (Name_Read, Aspect_Read), (Name_Shared, Aspect_Shared), (Name_Size, Aspect_Size), + (Name_Static_Predicate, Aspect_Static_Predicate), (Name_Storage_Pool, Aspect_Storage_Pool), (Name_Storage_Size, Aspect_Storage_Size), (Name_Stream_Size, Aspect_Stream_Size), diff --git a/gcc/ada/aspects.ads b/gcc/ada/aspects.ads index 6dabef3..bf37ffb 100755 --- a/gcc/ada/aspects.ads +++ b/gcc/ada/aspects.ads @@ -47,6 +47,7 @@ package Aspects is Aspect_Alignment, Aspect_Bit_Order, Aspect_Component_Size, + Aspect_Dynamic_Predicate, Aspect_External_Tag, Aspect_Input, Aspect_Invariant, @@ -55,9 +56,10 @@ package Aspects is Aspect_Output, Aspect_Post, Aspect_Pre, - Aspect_Predicate, + Aspect_Predicate, -- GNAT Aspect_Read, Aspect_Size, + Aspect_Static_Predicate, Aspect_Storage_Pool, Aspect_Storage_Size, Aspect_Stream_Size, @@ -128,6 +130,7 @@ package Aspects is Aspect_Alignment => Expression, Aspect_Bit_Order => Expression, Aspect_Component_Size => Expression, + Aspect_Dynamic_Predicate => Expression, Aspect_External_Tag => Expression, Aspect_Input => Name, Aspect_Invariant => Expression, @@ -139,6 +142,7 @@ package Aspects is Aspect_Predicate => Expression, Aspect_Read => Name, Aspect_Size => Expression, + Aspect_Static_Predicate => Expression, Aspect_Storage_Pool => Name, Aspect_Storage_Size => Expression, Aspect_Stream_Size => Expression, diff --git a/gcc/ada/expander.adb b/gcc/ada/expander.adb index 23d2aef..308b5d7 100644 --- a/gcc/ada/expander.adb +++ b/gcc/ada/expander.adb @@ -459,7 +459,6 @@ package body Expander is -- Deal with transient scopes if Scope_Is_Transient and then N = Node_To_Be_Wrapped then - case Nkind (N) is when N_Statement_Other_Than_Procedure_Call | N_Procedure_Call_Statement => diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index ef50ec4..6446b33 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -1054,9 +1054,12 @@ package body Sem_Ch13 is -- declaration, to get the required pragma placement. The -- pragma processing takes care of the required delay. - when Aspect_Predicate => + when Aspect_Dynamic_Predicate | + Aspect_Predicate | + Aspect_Static_Predicate => - -- Construct the pragma + -- Construct the pragma (always a pragma Predicate, with + -- flags recording whether Aitem := Make_Pragma (Loc, @@ -1068,6 +1071,14 @@ package body Sem_Ch13 is Set_From_Aspect_Specification (Aitem, True); + -- Set special flags for dynamic/static cases + + if A_Id = Aspect_Dynamic_Predicate then + Set_From_Dynamic_Predicate (Aitem); + elsif A_Id = Aspect_Static_Predicate then + Set_From_Static_Predicate (Aitem); + end if; + -- Make sure we have a freeze node (it might otherwise be -- missing in cases like subtype X is Y, and we would not -- have a place to build the predicate function). @@ -3818,6 +3829,13 @@ package body Sem_Ch13 is Object_Name : constant Name_Id := New_Internal_Name ('I'); -- Name for argument of Predicate procedure + Dynamic_Predicate_Present : Boolean := False; + -- Set True if a dynamic predicate is present, results in the entire + -- predicate being considered dynamic even if it looks static + + Static_Predicate_Present : Node_Id := Empty; + -- Set to N_Pragma node for a static predicate if one is encountered. + -------------- -- Add_Call -- -------------- @@ -3903,6 +3921,12 @@ package body Sem_Ch13 is if Nkind (Ritem) = N_Pragma and then Pragma_Name (Ritem) = Name_Predicate then + if From_Dynamic_Predicate (Ritem) then + Dynamic_Predicate_Present := True; + elsif From_Static_Predicate (Ritem) then + Static_Predicate_Present := Ritem; + end if; + Arg1 := First (Pragma_Argument_Associations (Ritem)); Arg2 := Next (Arg1); @@ -3945,7 +3969,7 @@ package body Sem_Ch13 is begin -- Initialize for construction of statement list - Expr := Empty; + Expr := Empty; -- Return if already built or if type does not have predicates @@ -4034,8 +4058,19 @@ package body Sem_Ch13 is E_Modular_Integer_Subtype, E_Signed_Integer_Subtype) and then Is_Static_Subtype (Typ) + and then not Dynamic_Predicate_Present then Build_Static_Predicate (Typ, Expr, Object_Name); + + if Present (Static_Predicate_Present) + and No (Static_Predicate (Typ)) + then + Error_Msg_F + ("expression does not have required form for " + & "static predicate", + Next (First (Pragma_Argument_Associations + (Static_Predicate_Present)))); + end if; end if; end if; end Build_Predicate_Function; @@ -5002,10 +5037,12 @@ package body Sem_Ch13 is -- Pre/Post/Invariant/Predicate take boolean expressions - when Aspect_Pre | - Aspect_Post | - Aspect_Invariant | - Aspect_Predicate => + when Aspect_Dynamic_Predicate | + Aspect_Invariant | + Aspect_Pre | + Aspect_Post | + Aspect_Predicate | + Aspect_Static_Predicate => T := Standard_Boolean; end case; diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb index 3d8e184..3a67e72 100644 --- a/gcc/ada/sinfo.adb +++ b/gcc/ada/sinfo.adb @@ -1360,6 +1360,22 @@ package body Sinfo is return Flag6 (N); end From_Default; + function From_Dynamic_Predicate + (N : Node_Id) return Boolean is + begin + pragma Assert (False + or else NT (N).Nkind = N_Pragma); + return Flag7 (N); + end From_Dynamic_Predicate; + + function From_Static_Predicate + (N : Node_Id) return Boolean is + begin + pragma Assert (False + or else NT (N).Nkind = N_Pragma); + return Flag8 (N); + end From_Static_Predicate; + function Generic_Associations (N : Node_Id) return List_Id is begin @@ -4388,6 +4404,22 @@ package body Sinfo is Set_Flag6 (N, Val); end Set_From_Default; + procedure Set_From_Dynamic_Predicate + (N : Node_Id; Val : Boolean := True) is + begin + pragma Assert (False + or else NT (N).Nkind = N_Pragma); + Set_Flag7 (N, Val); + end Set_From_Dynamic_Predicate; + + procedure Set_From_Static_Predicate + (N : Node_Id; Val : Boolean := True) is + begin + pragma Assert (False + or else NT (N).Nkind = N_Pragma); + Set_Flag8 (N, Val); + end Set_From_Static_Predicate; + procedure Set_Generic_Associations (N : Node_Id; Val : List_Id) is begin diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index c7e6f47..facc045 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -497,13 +497,6 @@ package Sinfo is -- has been inserted at the flagged node. This is used to avoid the -- generation of duplicate checks. - -- Has_Local_Raise (Flag8-Sem) - -- Present in exception handler nodes. Set if the handler can be entered - -- via a local raise that gets transformed to a goto statement. This will - -- always be set if Local_Raise_Statements is non-empty, but can also be - -- set as a result of generation of N_Raise_xxx nodes, or flags set in - -- nodes requiring generation of back end checks. - ------------------------------------ -- Description of Semantic Fields -- ------------------------------------ @@ -1108,6 +1101,14 @@ package Sinfo is -- declaration is treated as an implicit reference to the formal in the -- ali file. + -- From_Dynamic_Predicate (Flag7-Sem) + -- Set for generated pragma Predicate node if this is generated by a + -- Dynamic_Predicate aspect. + + -- From_Static_Predicate (Flag8-Sem) + -- Set for generated pragma Predicate node if this is generated by a + -- Static_Predicate aspect. + -- Generic_Parent (Node5-Sem) -- Generic_Parent is defined on declaration nodes that are instances. The -- value of Generic_Parent is the generic entity from which the instance @@ -1132,6 +1133,13 @@ package Sinfo is -- handler is deleted during optimization. For further details on why -- this is required, see Exp_Ch11.Remove_Handler_Entries. + -- Has_Local_Raise (Flag8-Sem) + -- Present in exception handler nodes. Set if the handler can be entered + -- via a local raise that gets transformed to a goto statement. This will + -- always be set if Local_Raise_Statements is non-empty, but can also be + -- set as a result of generation of N_Raise_xxx nodes, or flags set in + -- nodes requiring generation of back end checks. + -- Has_No_Elaboration_Code (Flag17-Sem) -- A flag that appears in the N_Compilation_Unit node to indicate whether -- or not elaboration code is present for this unit. It is initially set @@ -2074,6 +2082,8 @@ package Sinfo is -- Aspect_Cancel (Flag11-Sem) -- Split_PPC (Flag17) set if corresponding aspect had Split_PPC set -- Class_Present (Flag6) set if from Aspect with 'Class + -- From_Dynamic_Predicate (Flag7-Sem) Set if Dynamic_Predicate aspect + -- From_Static_Predicate (Flag8-Sem) Set if Static_Predicate aspect -- Note: we should have a section on what pragmas are passed on to -- the back end to be processed. This section should note that pragma @@ -8390,6 +8400,12 @@ package Sinfo is function From_Default (N : Node_Id) return Boolean; -- Flag6 + function From_Dynamic_Predicate + (N : Node_Id) return Boolean; -- Flag7 + + function From_Static_Predicate + (N : Node_Id) return Boolean; -- Flag8 + function Generic_Associations (N : Node_Id) return List_Id; -- List3 @@ -9356,6 +9372,12 @@ package Sinfo is procedure Set_From_Default (N : Node_Id; Val : Boolean := True); -- Flag6 + procedure Set_From_Dynamic_Predicate + (N : Node_Id; Val : Boolean := True); -- Flag7 + + procedure Set_From_Static_Predicate + (N : Node_Id; Val : Boolean := True); -- Flag8 + procedure Set_Generic_Associations (N : Node_Id; Val : List_Id); -- List3 @@ -11775,6 +11797,8 @@ package Sinfo is pragma Inline (From_At_End); pragma Inline (From_At_Mod); pragma Inline (From_Default); + pragma Inline (From_Dynamic_Predicate); + pragma Inline (From_Static_Predicate); pragma Inline (Generic_Associations); pragma Inline (Generic_Formal_Declarations); pragma Inline (Generic_Parent); @@ -12094,6 +12118,8 @@ package Sinfo is pragma Inline (Set_From_At_End); pragma Inline (Set_From_At_Mod); pragma Inline (Set_From_Default); + pragma Inline (Set_From_Dynamic_Predicate); + pragma Inline (Set_From_Static_Predicate); pragma Inline (Set_Generic_Associations); pragma Inline (Set_Generic_Formal_Declarations); pragma Inline (Set_Generic_Parent); diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl index 1a5eb03..9e5921c 100644 --- a/gcc/ada/snames.ads-tmpl +++ b/gcc/ada/snames.ads-tmpl @@ -137,8 +137,10 @@ package Snames is -- Names of aspects for which there are no matching pragmas or attributes -- so that they need to be included for aspect specification use. + Name_Dynamic_Predicate : constant Name_Id := N + $; Name_Post : constant Name_Id := N + $; Name_Pre : constant Name_Id := N + $; + Name_Static_Predicate : constant Name_Id := N + $; -- Some special names used by the expander. Note that the lower case u's -- at the start of these names get translated to extra underscores. These diff --git a/gcc/ada/usage.adb b/gcc/ada/usage.adb index 4d395b4..5b0f605 100644 --- a/gcc/ada/usage.adb +++ b/gcc/ada/usage.adb @@ -594,7 +594,7 @@ begin -- Line for -gnat83 switch Write_Switch_Char ("83"); - Write_Line ("Enforce Ada 83 restrictions"); + Write_Line ("Ada 83 mode"); -- Line for -gnat95 switch @@ -603,27 +603,27 @@ begin if Ada_Version_Default = Ada_95 then Write_Line ("Ada 95 mode (default)"); else - Write_Line ("Enforce Ada 95 restrictions"); + Write_Line ("Ada 95 mode"); end if; - -- Line for -gnat05 switch + -- Line for -gnat2005 switch - Write_Switch_Char ("05"); + Write_Switch_Char ("2005"); if Ada_Version_Default = Ada_2005 then Write_Line ("Ada 2005 mode (default)"); else - Write_Line ("Enforce Ada 2005 restrictions"); + Write_Line ("Ada 2005 mode"); end if; - -- Line for -gnat12 switch + -- Line for -gnat2012 switch - Write_Switch_Char ("12"); + Write_Switch_Char ("2012"); if Ada_Version_Default = Ada_2012 then Write_Line ("Ada 2012 mode (default)"); else - Write_Line ("Allow Ada 2012 extensions"); + Write_Line ("Ada 2012 mode"); end if; -- Line for -gnat-p switch |