[Ada] System'To_Address not always static

System'To_Address is supposed to be static when its parameter is static.
This patch fixes a bug in which it is considered nonstatic when used as
the initial value of a variable with the Thread_Local_Storage aspect, so
the compiler incorrectly gives an error when initializing such a
variable with System'To_Address (0).

2018-11-14  Bob Duff  <duff@adacore.com>

gcc/ada/

	* sem_attr.adb (To_Address): Simplify setting of
	Is_Static_Expression. Remove second (unconditional) call to
	Set_Is_Static_Expression -- surely it's not static if the
	operand is not.  Initialize Static on declaration.  Do not try
	to fold 'To_Address, even though it's static.
	* exp_attr.adb (To_Address): Preserve Is_Static_Expression.
	* sinfo.ads, sem_eval.ads, sem_eval.adb (Is_Static_Expression,
	Is_OK_Static_Expression, Raises_Constraint_Error): Simplify
	documentation.  There was too much repetition and redundancy.

From-SVN: r266124

6 files changed, 90 insertions, 104 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 3af78024531..52ea778131a 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,15 @@
+2018-11-14  Bob Duff  <duff@adacore.com>
+
+	* sem_attr.adb (To_Address): Simplify setting of
+	Is_Static_Expression. Remove second (unconditional) call to
+	Set_Is_Static_Expression -- surely it's not static if the
+	operand is not.  Initialize Static on declaration.  Do not try
+	to fold 'To_Address, even though it's static.
+	* exp_attr.adb (To_Address): Preserve Is_Static_Expression.
+	* sinfo.ads, sem_eval.ads, sem_eval.adb (Is_Static_Expression,
+	Is_OK_Static_Expression, Raises_Constraint_Error): Simplify
+	documentation.  There was too much repetition and redundancy.
+
 2018-11-14  Ed Schonberg  <schonberg@adacore.com>
 
 	* sem_ch3.adb (Analyze_Object_Declaration): Use the
diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index d789748613b..2c2442a3bc8 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -6605,15 +6605,20 @@ package body Exp_Attr is
       ----------------
 
       --  Transforms System'To_Address (X) and System.Address'Ref (X) into
-      --  unchecked conversion from (integral) type of X to type address.
+      --  unchecked conversion from (integral) type of X to type address. If
+      --  the To_Address is a static expression, the transformed expression
+      --  also needs to be static, because we do some legality checks (e.g.
+      --  for Thread_Local_Storage) after this transformation.
 
-      when Attribute_Ref
-         | Attribute_To_Address
-      =>
+      when Attribute_Ref | Attribute_To_Address => To_Address : declare
+         Is_Static : constant Boolean := Is_Static_Expression (N);
+      begin
          Rewrite (N,
            Unchecked_Convert_To (RTE (RE_Address),
              Relocate_Node (First (Exprs))));
+         Set_Is_Static_Expression (N, Is_Static);
          Analyze_And_Resolve (N, RTE (RE_Address));
+      end To_Address;
 
       ------------
       -- To_Any --
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 715ec954552..30cdc95eb65 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -6144,7 +6144,6 @@ package body Sem_Attr is
 
       when Attribute_To_Address => To_Address : declare
          Val : Uint;
-
       begin
          Check_E1;
          Analyze (P);
@@ -6153,10 +6152,7 @@ package body Sem_Attr is
          Generate_Reference (RTE (RE_Address), P);
          Analyze_And_Resolve (E1, Any_Integer);
          Set_Etype (N, RTE (RE_Address));
-
-         if Is_Static_Expression (E1) then
-            Set_Is_Static_Expression (N, True);
-         end if;
+         Set_Is_Static_Expression (N, Is_Static_Expression (E1));
 
          --  OK static expression case, check range and set appropriate type
 
@@ -6188,8 +6184,6 @@ package body Sem_Attr is
                Set_Etype (E1, Standard_Unsigned_64);
             end if;
          end if;
-
-         Set_Is_Static_Expression (N, True);
       end To_Address;
 
       ------------
@@ -7202,7 +7196,7 @@ package body Sem_Attr is
       P_Root_Type : Entity_Id;
       --  The root type of the prefix type
 
-      Static : Boolean;
+      Static : Boolean := False;
       --  True if the result is Static. This is set by the general processing
       --  to true if the prefix is static, and all expressions are static. It
       --  can be reset as processing continues for particular attributes. This
@@ -7563,10 +7557,16 @@ package body Sem_Attr is
    --  Start of processing for Eval_Attribute
 
    begin
+      --  The To_Address attribute can be static, but it cannot be evaluated at
+      --  compile time, so just return.
+
+      if Id = Attribute_To_Address then
+         return;
+      end if;
+
       --  Initialize result as non-static, will be reset if appropriate
 
       Set_Is_Static_Expression (N, False);
-      Static := False;
 
       --  Acquire first two expressions (at the moment, no attributes take more
       --  than two expressions in any case).
@@ -8283,8 +8283,8 @@ package body Sem_Attr is
          --  static attribute in GNAT.
 
          Analyze_And_Resolve (N, Standard_Boolean);
-            Static := True;
-            Set_Is_Static_Expression (N, True);
+         Static := True;
+         Set_Is_Static_Expression (N, True);
       end Atomic_Always_Lock_Free;
 
       ---------
@@ -8346,7 +8346,6 @@ package body Sem_Attr is
          --  attribute reference, and this reference is not static.
 
          Set_Is_Static_Expression (N, False);
-         null;
 
       ---------------
       -- Copy_Sign --
@@ -8737,8 +8736,8 @@ package body Sem_Attr is
          --  static attribute in GNAT.
 
          Analyze_And_Resolve (N, Standard_Boolean);
-            Static := True;
-            Set_Is_Static_Expression (N, True);
+         Static := True;
+         Set_Is_Static_Expression (N, True);
       end Lock_Free;
 
       ----------
diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb
index 4560a512fb8..ec98a3af8d2 100644
--- a/gcc/ada/sem_eval.adb
+++ b/gcc/ada/sem_eval.adb
@@ -66,33 +66,25 @@ package body Sem_Eval is
    --  a subexpression is resolved and is therefore accomplished in a bottom
    --  up fashion. The flags are synthesized using the following approach.
 
-   --    Is_Static_Expression is determined by following the detailed rules
-   --    in RM 4.9(4-14). This involves testing the Is_Static_Expression
-   --    flag of the operands in many cases.
-
-   --    Raises_Constraint_Error is set if any of the operands have the flag
-   --    set or if an attempt to compute the value of the current expression
-   --    results in detection of a runtime constraint error.
-
-   --  As described in the spec, the requirement is that Is_Static_Expression
-   --  be accurately set, and in addition for nodes for which this flag is set,
-   --  Raises_Constraint_Error must also be set. Furthermore a node which has
-   --  Is_Static_Expression set, and Raises_Constraint_Error clear, then the
-   --  requirement is that the expression value must be precomputed, and the
-   --  node is either a literal, or the name of a constant entity whose value
-   --  is a static expression.
+   --    Is_Static_Expression is determined by following the rules in
+   --    RM-4.9. This involves testing the Is_Static_Expression flag of
+   --    the operands in many cases.
+
+   --    Raises_Constraint_Error is usually set if any of the operands have
+   --    the flag set or if an attempt to compute the value of the current
+   --    expression results in Constraint_Error.
 
    --  The general approach is as follows. First compute Is_Static_Expression.
    --  If the node is not static, then the flag is left off in the node and
    --  we are all done. Otherwise for a static node, we test if any of the
-   --  operands will raise constraint error, and if so, propagate the flag
+   --  operands will raise Constraint_Error, and if so, propagate the flag
    --  Raises_Constraint_Error to the result node and we are done (since the
    --  error was already posted at a lower level).
 
    --  For the case of a static node whose operands do not raise constraint
    --  error, we attempt to evaluate the node. If this evaluation succeeds,
    --  then the node is replaced by the result of this computation. If the
-   --  evaluation raises constraint error, then we rewrite the node with
+   --  evaluation raises Constraint_Error, then we rewrite the node with
    --  Apply_Compile_Time_Constraint_Error to raise the exception and also
    --  to post appropriate error messages.
 
@@ -108,7 +100,7 @@ package body Sem_Eval is
    --  discrete types (the most common case), and is populated by calls to
    --  Compile_Time_Known_Value and Expr_Value, but only used by Expr_Value
    --  since it is possible for the status to change (in particular it is
-   --  possible for a node to get replaced by a constraint error node).
+   --  possible for a node to get replaced by a Constraint_Error node).
 
    CV_Bits : constant := 5;
    --  Number of low order bits of Node_Id value used to reference entries
@@ -295,8 +287,8 @@ package body Sem_Eval is
    --    If either operand is Any_Type then propagate it to result to prevent
    --    cascaded errors.
    --
-   --    If some operand raises constraint error, then replace the node N
-   --    with the raise constraint error node. This replacement inherits the
+   --    If some operand raises Constraint_Error, then replace the node N
+   --    with the raise Constraint_Error node. This replacement inherits the
    --    Is_Static_Expression flag from the operands.
 
    procedure Test_Expression_Is_Foldable
@@ -1129,7 +1121,7 @@ package body Sem_Eval is
          return Unknown;
       end if;
 
-      --  If either operand could raise constraint error, then we cannot
+      --  If either operand could raise Constraint_Error, then we cannot
       --  know the result at compile time (since CE may be raised).
 
       if not (Cannot_Raise_Constraint_Error (L)
@@ -1696,7 +1688,7 @@ package body Sem_Eval is
       CV_Ent : CV_Entry renames CV_Cache (Nat (Op) mod CV_Cache_Size);
 
    begin
-      --  Never known at compile time if bad type or raises constraint error
+      --  Never known at compile time if bad type or raises Constraint_Error
       --  or empty (latter case occurs only as a result of a previous error).
 
       if No (Op) then
@@ -2201,7 +2193,7 @@ package body Sem_Eval is
       end if;
 
       --  First loop, make sure all the alternatives are static expressions
-      --  none of which raise Constraint_Error. We make the constraint error
+      --  none of which raise Constraint_Error. We make the Constraint_Error
       --  check because part of the legality condition for a correct static
       --  case expression is that the cases are covered, like any other case
       --  expression. And we can't do that if any of the conditions raise an
@@ -2237,7 +2229,7 @@ package body Sem_Eval is
 
       Set_Is_Static_Expression (N);
 
-      --  Now to deal with propagating a possible constraint error
+      --  Now to deal with propagating a possible Constraint_Error
 
       --  If the selecting expression raises CE, propagate and we are done
 
@@ -2408,7 +2400,7 @@ package body Sem_Eval is
 
    begin
       --  Enumeration literals are always considered to be constants
-      --  and cannot raise constraint error (RM 4.9(22)).
+      --  and cannot raise Constraint_Error (RM 4.9(22)).
 
       if Ekind (Def_Id) = E_Enumeration_Literal then
          Set_Is_Static_Expression (N);
@@ -2506,7 +2498,7 @@ package body Sem_Eval is
          return;
       end if;
 
-      --  If condition raises constraint error then we have already signaled
+      --  If condition raises Constraint_Error then we have already signaled
       --  an error, and we just propagate to the result and do not fold.
 
       if Raises_Constraint_Error (Condition) then
@@ -2531,8 +2523,8 @@ package body Sem_Eval is
       end if;
 
       --  Note that it does not matter if the non-result operand raises a
-      --  Constraint_Error, but if the result raises constraint error then we
-      --  replace the node with a raise constraint error. This will properly
+      --  Constraint_Error, but if the result raises Constraint_Error then we
+      --  replace the node with a raise Constraint_Error. This will properly
       --  propagate Raises_Constraint_Error since this flag is set in Result.
 
       if Raises_Constraint_Error (Result) then
@@ -2884,7 +2876,7 @@ package body Sem_Eval is
 
       Set_Is_Static_Expression (N);
 
-      --  If left operand raises constraint error, propagate and we are done
+      --  If left operand raises Constraint_Error, propagate and we are done
 
       if Raises_Constraint_Error (Expr) then
          Set_Raises_Constraint_Error (N, True);
@@ -3117,7 +3109,7 @@ package body Sem_Eval is
       if not Fold then
          return;
 
-      --  Don't try fold if target type has constraint error bounds
+      --  Don't try fold if target type has Constraint_Error bounds
 
       elsif not Is_OK_Static_Subtype (Target_Type) then
          Set_Raises_Constraint_Error (N);
@@ -3645,7 +3637,7 @@ package body Sem_Eval is
       --  Now look at the operands, we can't quite use the normal call to
       --  Test_Expression_Is_Foldable here because short circuit operations
       --  are a special case, they can still be foldable, even if the right
-      --  operand raises constraint error.
+      --  operand raises Constraint_Error.
 
       --  If either operand is Any_Type, just propagate to result and do not
       --  try to fold, this prevents cascaded errors.
@@ -3654,8 +3646,8 @@ package body Sem_Eval is
          Set_Etype (N, Any_Type);
          return;
 
-      --  If left operand raises constraint error, then replace node N with
-      --  the raise constraint error node, and we are obviously not foldable.
+      --  If left operand raises Constraint_Error, then replace node N with
+      --  the raise Constraint_Error node, and we are obviously not foldable.
       --  Is_Static_Expression is set from the two operands in the normal way,
       --  and we check the right operand if it is in a non-static context.
 
@@ -3678,12 +3670,12 @@ package body Sem_Eval is
 
       --  Here the result is static, note that, unlike the normal processing
       --  in Test_Expression_Is_Foldable, we did *not* check above to see if
-      --  the right operand raises constraint error, that's because it is not
+      --  the right operand raises Constraint_Error, that's because it is not
       --  significant if the left operand is decisive.
 
       Set_Is_Static_Expression (N);
 
-      --  It does not matter if the right operand raises constraint error if
+      --  It does not matter if the right operand raises Constraint_Error if
       --  it will not be evaluated. So deal specially with the cases where
       --  the right operand is not evaluated. Note that we will fold these
       --  cases even if the right operand is non-static, which is fine, but
@@ -3700,7 +3692,7 @@ package body Sem_Eval is
       end if;
 
       --  If first operand not decisive, then it does matter if the right
-      --  operand raises constraint error, since it will be evaluated, so
+      --  operand raises Constraint_Error, since it will be evaluated, so
       --  we simply replace the node with the right operand. Note that this
       --  properly propagates Is_Static_Expression and Raises_Constraint_Error
       --  (both are set to True in Right).
@@ -3951,7 +3943,7 @@ package body Sem_Eval is
       if not Fold then
          return;
 
-      --  Don't try fold if target type has constraint error bounds
+      --  Don't try fold if target type has Constraint_Error bounds
 
       elsif not Is_OK_Static_Subtype (Target_Type) then
          Set_Raises_Constraint_Error (N);
@@ -4915,7 +4907,7 @@ package body Sem_Eval is
    --------------------------
 
    --  Determines if Typ is a static subtype as defined in (RM 4.9(26)) where
-   --  neither bound raises constraint error when evaluated.
+   --  neither bound raises Constraint_Error when evaluated.
 
    function Is_OK_Static_Subtype (Typ : Entity_Id) return Boolean is
       Base_T   : constant Entity_Id := Base_Type (Typ);
@@ -6044,7 +6036,7 @@ package body Sem_Eval is
                      then
                         return False;
 
-                        --  If either expression raised a constraint error,
+                        --  If either expression raised a Constraint_Error,
                         --  consider the expressions as matching, since this
                         --  helps to prevent cascading errors.
 
@@ -6255,8 +6247,8 @@ package body Sem_Eval is
          Set_Etype (N, Any_Type);
          return;
 
-      --  If operand raises constraint error, then replace node N with the
-      --  raise constraint error node, and we are obviously not foldable.
+      --  If operand raises Constraint_Error, then replace node N with the
+      --  raise Constraint_Error node, and we are obviously not foldable.
       --  Note that this replacement inherits the Is_Static_Expression flag
       --  from the operand.
 
@@ -6283,7 +6275,7 @@ package body Sem_Eval is
          return;
 
       --  Here we have the case of an operand whose type is OK, which is
-      --  static, and which does not raise constraint error, we can fold.
+      --  static, and which does not raise Constraint_Error, we can fold.
 
       else
          Set_Is_Static_Expression (N);
@@ -6323,7 +6315,7 @@ package body Sem_Eval is
          Set_Etype (N, Any_Type);
          return;
 
-      --  If left operand raises constraint error, then replace node N with the
+      --  If left operand raises Constraint_Error, then replace node N with the
       --  Raise_Constraint_Error node, and we are obviously not foldable.
       --  Is_Static_Expression is set from the two operands in the normal way,
       --  and we check the right operand if it is in a non-static context.
@@ -6376,7 +6368,7 @@ package body Sem_Eval is
          return;
 
       --  Else result is static and foldable. Both operands are static, and
-      --  neither raises constraint error, so we can definitely fold.
+      --  neither raises Constraint_Error, so we can definitely fold.
 
       else
          Set_Is_Static_Expression (N);
@@ -6413,7 +6405,7 @@ package body Sem_Eval is
       if Error_Posted (N) then
          return Unknown;
 
-      --  Expression that raises constraint error is an odd case. We certainly
+      --  Expression that raises Constraint_Error is an odd case. We certainly
       --  do not want to consider it to be in range. It might make sense to
       --  consider it always out of range, but this causes incorrect error
       --  messages about static expressions out of range. So we just return
@@ -6601,7 +6593,7 @@ package body Sem_Eval is
             return;
          end if;
 
-         --  Test for constraint error raised
+         --  Test for Constraint_Error raised
 
          if Raises_Constraint_Error (Expr) then
 
diff --git a/gcc/ada/sem_eval.ads b/gcc/ada/sem_eval.ads
index 7319eb95eae..3c71a57fb9f 100644
--- a/gcc/ada/sem_eval.ads
+++ b/gcc/ada/sem_eval.ads
@@ -51,13 +51,7 @@ package Sem_Eval is
 
    --    Is_Static_Expression
 
-   --      This flag is set on any expression that is static according to the
-   --      rules in (RM 4.9(3-32)). This flag should be tested during testing
-   --      of legality of parts of a larger static expression. For all other
-   --      contexts that require static expressions, use the separate predicate
-   --      Is_OK_Static_Expression, since an expression that meets the RM 4.9
-   --      requirements, but raises a constraint error when evaluated in a non-
-   --      static context does not meet the legality requirements.
+   --      True for static expressions, as defined in RM-4.9.
 
    --    Raises_Constraint_Error
 
@@ -68,31 +62,28 @@ package Sem_Eval is
    --      (i.e. the flag is accurate for static expressions, and conservative
    --      for non-static expressions.
 
-   --  If a static expression does not raise constraint error, then it will
-   --  have the flag Raises_Constraint_Error flag False, and the expression
-   --  must be computed at compile time, which means that it has the form of
-   --  either a literal, or a constant that is itself (recursively) either a
-   --  literal or a constant.
+   --  See also Is_OK_Static_Expression, which is True for static
+   --  expressions that do not raise Constraint_Error. This is used in most
+   --  legality checks, because static expressions that raise Constraint_Error
+   --  are usually illegal.
 
-   --  The above rules must be followed exactly in order for legality checks to
-   --  be accurate. For subexpressions that are not static according to the RM
-   --  definition, they are sometimes folded anyway, but of course in this case
-   --  Is_Static_Expression is not set.
+   --  See also Compile_Time_Known_Value, which is True for an expression whose
+   --  value is known at compile time. In this case, the expression is folded
+   --  to a literal or to a constant that is itself (recursively) either a
+   --  literal or a constant
+
+   --  Is_[OK_]Static_Expression are used for legality checks, whereas
+   --  Compile_Time_Known_Value is used for optimization purposes.
 
    --  When we are analyzing and evaluating static expressions, we propagate
-   --  both flags accurately. Usually if a subexpression raises a constraint
-   --  error, then so will its parent expression, and Raise_Constraint_Error
-   --  will be propagated to this parent. The exception is conditional cases
-   --  like (True or else 1/0 = 0) which results in an expresion that has the
+   --  both flags. Usually if a subexpression raises a Constraint_Error, then
+   --  so will its parent expression, and Raise_Constraint_Error will be
+   --  propagated to this parent. The exception is conditional cases like
+   --  (True or else 1/0 = 0), which results in an expression that has the
    --  Is_Static_Expression flag True, and Raises_Constraint_Error False. Even
    --  though 1/0 would raise an exception, the right operand is never actually
    --  executed, so the expression as a whole does not raise CE.
 
-   --  For constructs in the language where static expressions are part of the
-   --  required semantics, we need an expression that meets the 4.9 rules and
-   --  does not raise CE. So nearly everywhere, callers should call function
-   --  Is_OK_Static_Expression rather than Is_Static_Expression.
-
    --  Finally, the case of static predicates. These are applied only to entire
    --  expressions, not to subexpressions, so we do not have the case of having
    --  to propagate this information. We handle this case simply by resetting
diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads
index 801bd21fca7..efba51b3cfc 100644
--- a/gcc/ada/sinfo.ads
+++ b/gcc/ada/sinfo.ads
@@ -1966,12 +1966,7 @@ package Sinfo is
 
    --  Is_Static_Expression (Flag6-Sem)
    --    Indicates that an expression is a static expression according to the
-   --    rules in (RM 4.9). Note that it is possible for this flag to be set
-   --    when Raises_Constraint_Error is also set. In practice almost all cases
-   --    where a static expression is required do not allow an expression which
-   --    raises Constraint_Error, so almost always, callers should call the
-   --    Is_Ok_Static_Expression routine instead of testing this flag. See
-   --    spec of package Sem_Eval for full details on the use of this flag.
+   --    rules in RM-4.9. See Sem_Eval for details.
 
    --  Is_Subprogram_Descriptor (Flag16-Sem)
    --    Present in N_Object_Declaration, and set only for the object
@@ -2297,15 +2292,7 @@ package Sinfo is
 
    --  Raises_Constraint_Error (Flag7-Sem)
    --    Set on an expression whose evaluation will definitely fail constraint
-   --    error check. In the case of static expressions, this flag must be set
-   --    accurately (and if it is set, the expression is typically illegal
-   --    unless it appears as a non-elaborated branch of a short-circuit form).
-   --    For a non-static expression, this flag may be set whenever an
-   --    expression (e.g. an aggregate) is known to raise constraint error. If
-   --    set, the expression definitely will raise CE if elaborated at runtime.
-   --    If not set, the expression may or may not raise CE. In other words, on
-   --    static expressions, the flag is set accurately, on non-static
-   --    expressions it is set conservatively.
+   --    error check. See Sem_Eval for details.
 
    --  Redundant_Use (Flag13-Sem)
    --    Present in nodes that can appear as an operand in a use clause or use