diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 21 | ||||
| -rw-r--r-- | gcc/ada/a-envvar.adb | 11 | ||||
| -rw-r--r-- | gcc/ada/a-envvar.ads | 5 | ||||
| -rw-r--r-- | gcc/ada/exp_ch6.adb | 19 | ||||
| -rw-r--r-- | gcc/ada/sem_prag.adb | 94 |
5 files changed, 119 insertions, 31 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 2885785..633ac55 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,24 @@ +2013-04-23 Hristian Kirtchev <kirtchev@adacore.com> + + * sem_prag.adb (Analyze_Dependency_Clause): Update all calls to + Analyze_Input_Output. + (Analyze_Input_List): Update all calls to Analyze_Input_Output. + (Analyze_Input_Output): Add formal parameter Self_Ref along with + comment on its usage. Update all calls to Analyze_Input_Output. + (Analyze_Pragma): Add new local variable Self_Ref to capture + the presence of a self-referential dependency clause. Update + all calls to Analyze_Input_Output. + (Check_Mode): Add formal parameter Self_Ref along with comment on its + usage. Verify the legality of a self-referential output. + +2013-04-23 Ed Schonberg <schonberg@adacore.com> + + * exp_ch6.adb: Add predicate checks on by-copy parameter. + +2013-04-23 Vincent Celier <celier@adacore.com> + + * a-envvar.adb, a-envvar.ads (Value): New. + 2013-04-22 Yannick Moy <moy@adacore.com> * exp_prag.adb (Expand_Pragma_Loop_Variant): Rewrite pragma as diff --git a/gcc/ada/a-envvar.adb b/gcc/ada/a-envvar.adb index d0caa25..1b1f425 100644 --- a/gcc/ada/a-envvar.adb +++ b/gcc/ada/a-envvar.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2009-2012, Free Software Foundation, Inc. -- +-- Copyright (C) 2009-2013, 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- -- @@ -223,4 +223,13 @@ package body Ada.Environment_Variables is end if; end Value; + function Value (Name : String; Default : String) return String is + begin + if Exists (Name) then + return Value (Name); + + else + return Default; + end if; + end Value; end Ada.Environment_Variables; diff --git a/gcc/ada/a-envvar.ads b/gcc/ada/a-envvar.ads index 9769c9b..dd160fc 100644 --- a/gcc/ada/a-envvar.ads +++ b/gcc/ada/a-envvar.ads @@ -23,6 +23,11 @@ package Ada.Environment_Variables is -- Constraint_Error is propagated. If the execution environment does not -- support environment variables, then Program_Error is propagated. + function Value (Name : String; Default : String) return String; + -- If the external execution environment supports environment variables and + -- an environment variable with the given name currently exists, then Value + -- returns its value; otherwise, it returns Default. + function Exists (Name : String) return Boolean; -- If the external execution environment supports environment variables and -- an environment variable with the given name currently exists, then diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index fffeb9c..11c440b 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -23,6 +23,7 @@ -- -- ------------------------------------------------------------------------------ +with Aspects; use Aspects; with Atree; use Atree; with Checks; use Checks; with Debug; use Debug; @@ -1707,8 +1708,22 @@ package body Exp_Ch6 is -- function, so it must be done explicitly after the call. Ditto -- if the actual is an entity of a predicated subtype. - if Is_By_Reference_Type (E_Formal) - and then Has_Predicates (E_Actual) + -- The rule refers to by-reference types, but a check is needed + -- for by-copy types as well. That check is subsumed by the rule + -- for subtype conversion on assignment, but we can generate the + -- required check now. + + -- Note that this is needed only if the subtype of the actual has + -- an explicit predicate aspect, not if it inherits them from a + -- base type or ancestor. The check is also superfluous if the + -- subtype is elaborated before the body of the subprogram, but + -- this is harder to verify, and there may be a redundant check. + + if (Present (Find_Aspect (E_Actual, Aspect_Predicate)) + or else Present + (Find_Aspect (E_Actual, Aspect_Dynamic_Predicate)) + or else Present + (Find_Aspect (E_Actual, Aspect_Static_Predicate))) and then not Is_Init_Proc (Subp) then if Is_Derived_Type (E_Actual) diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 66d772c..2deeb8f 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -9346,10 +9346,14 @@ package body Sem_Prag is procedure Check_Mode (Item : Node_Id; Item_Id : Entity_Id; - Is_Input : Boolean); + Is_Input : Boolean; + Self_Ref : Boolean); -- Ensure that an item has a proper "in", "in out" or "out" mode -- depending on its function. If this is not the case, emit an - -- error. + -- error. Item and Item_Id denote the attributes of an item. Flag + -- Is_Input should be set when item comes from an input list. + -- Flag Self_Ref should be set when the item is an output and the + -- dependency clause has operator "+". procedure Check_Usage (Subp_List : Elist_Id; @@ -9382,16 +9386,19 @@ package body Sem_Prag is procedure Analyze_Input_Output (Item : Node_Id; Is_Input : Boolean; + Self_Ref : Boolean; Top_Level : Boolean; Seen : in out Elist_Id; Null_Seen : in out Boolean); -- Verify the legality of a single input or output item. Flag -- Is_Input should be set whenever Item is an input, False when - -- it denotes an output. Flag Top_Level should be set whenever - -- Item appears immediately within an input or output list. - -- Seen is a collection of all abstract states, variables and - -- formals processed so far. Flag Null_Seen denotes whether a - -- null input or output has been encountered. + -- it denotes an output. Flag Self_Ref should be set when the + -- item is an output and the dependency clause has a "+". Flag + -- Top_Level should be set whenever Item appears immediately + -- within an input or output list. Seen is a collection of all + -- abstract states, variables and formals processed so far. + -- Flag Null_Seen denotes whether a null input or output has + -- been encountered. ------------------------ -- Analyze_Input_List -- @@ -9421,6 +9428,7 @@ package body Sem_Prag is Analyze_Input_Output (Item => Input, Is_Input => True, + Self_Ref => False, Top_Level => False, Seen => Inputs_Seen, Null_Seen => Null_Input_Seen); @@ -9439,6 +9447,7 @@ package body Sem_Prag is Analyze_Input_Output (Item => Inputs, Is_Input => True, + Self_Ref => False, Top_Level => False, Seen => Inputs_Seen, Null_Seen => Null_Input_Seen); @@ -9462,6 +9471,7 @@ package body Sem_Prag is procedure Analyze_Input_Output (Item : Node_Id; Is_Input : Boolean; + Self_Ref : Boolean; Top_Level : Boolean; Seen : in out Elist_Id; Null_Seen : in out Boolean) @@ -9490,6 +9500,7 @@ package body Sem_Prag is Analyze_Input_Output (Item => Grouped, Is_Input => Is_Input, + Self_Ref => Self_Ref, Top_Level => False, Seen => Seen, Null_Seen => Null_Seen); @@ -9576,7 +9587,7 @@ package body Sem_Prag is -- Ensure that the item is of the correct mode -- depending on its function. - Check_Mode (Item, Item_Id, Is_Input); + Check_Mode (Item, Item_Id, Is_Input, Self_Ref); -- Detect multiple uses of the same state, variable -- or formal parameter. If this is not the case, @@ -9631,12 +9642,24 @@ package body Sem_Prag is -- Local variables - Inputs : Node_Id; - Output : Node_Id; + Inputs : Node_Id; + Output : Node_Id; + Self_Ref : Boolean; -- Start of processing for Analyze_Dependency_Clause begin + Inputs := Expression (Clause); + Self_Ref := False; + + -- An input list with a self-dependency appears as operator "+" + -- where the actuals inputs are the right operand. + + if Nkind (Inputs) = N_Op_Plus then + Inputs := Right_Opnd (Inputs); + Self_Ref := True; + end if; + -- Process the output_list of a dependency_clause Output := First (Choices (Clause)); @@ -9644,6 +9667,7 @@ package body Sem_Prag is Analyze_Input_Output (Item => Output, Is_Input => False, + Self_Ref => Self_Ref, Top_Level => True, Seen => Outputs_Seen, Null_Seen => Null_Output_Seen); @@ -9653,15 +9677,6 @@ package body Sem_Prag is -- Process the input_list of a dependency_clause - Inputs := Expression (Clause); - - -- An input list with a self-dependency appears as operator "+" - -- where the actuals inputs are the right operand. - - if Nkind (Inputs) = N_Op_Plus then - Inputs := Right_Opnd (Inputs); - end if; - Analyze_Input_List (Inputs); end Analyze_Dependency_Clause; @@ -9717,9 +9732,12 @@ package body Sem_Prag is procedure Check_Mode (Item : Node_Id; Item_Id : Entity_Id; - Is_Input : Boolean) + Is_Input : Boolean; + Self_Ref : Boolean) is begin + -- Input + if Is_Input then if Ekind (Item_Id) = E_Out_Parameter or else (Global_Seen @@ -9729,17 +9747,37 @@ package body Sem_Prag is ("item & must have mode in or in out", Item, Item_Id); end if; - -- Output + -- Self-referential output - else - if Ekind (Item_Id) = E_In_Parameter - or else - (Global_Seen - and then not Appears_In (Subp_Outputs, Item_Id)) - then + elsif Self_Ref then + + -- A self-referential state or variable must appear in both + -- input and output lists of a subprogram. + + if Ekind_In (Item_Id, E_Abstract_State, E_Variable) then + if Global_Seen + and then not Appears_In (Subp_Inputs, Item_Id) + then + Error_Msg_NE + ("item & must have mode in out", Item, Item_Id); + end if; + + -- Self-referential parameter + + elsif Ekind (Item_Id) /= E_In_Out_Parameter then Error_Msg_NE - ("item & must have mode out or in out", Item, Item_Id); + ("item & must have mode in out", Item, Item_Id); end if; + + -- Regular output + + elsif Ekind (Item_Id) = E_In_Parameter + or else + (Global_Seen + and then not Appears_In (Subp_Outputs, Item_Id)) + then + Error_Msg_NE + ("item & must have mode out or in out", Item, Item_Id); end if; end Check_Mode; |