2013-04-23 Hristian Kirtchev <kirtchev@adacore.com>
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Tue, 23 Apr 2013 09:06:42 +0000 (09:06 +0000)
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Tue, 23 Apr 2013 09:06:42 +0000 (09:06 +0000)
* 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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@198177 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/ada/ChangeLog
gcc/ada/a-envvar.adb
gcc/ada/a-envvar.ads
gcc/ada/exp_ch6.adb
gcc/ada/sem_prag.adb

index 2885785..633ac55 100644 (file)
@@ -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
index d0caa25..1b1f425 100644 (file)
@@ -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;
index 9769c9b..dd160fc 100644 (file)
@@ -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
index fffeb9c..11c440b 100644 (file)
@@ -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)
index 66d772c..2deeb8f 100644 (file)
@@ -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;