[multiple changes]

2017-04-25  Thomas Quinot  <quinot@adacore.com>

	* sem_prag.adb (Analyze_Pragma, case Pragma_Check): Remove
	bogus circuitry for the case where Name is Predicate.

2017-04-25  Thomas Quinot  <quinot@adacore.com>

	* par_sco.adb(Traverse_Declarations_Or_Statements.Traverse_Aspects):
	Create SCOs for Predicate aspects in disabled
	state initially, to be enabled later on by...
	* sem_ch13.adb (Build_Predicate_Functions.Add_Predicates): Mark
	SCO for predicate as enabled.

2017-04-25  Hristian Kirtchev  <kirtchev@adacore.com>

	* comperr.adb (Compiler_Abort): Remove now obsolete pair of
	pragmas Warnings Off / On.
	* namet.adb (Finalize): Remove now obsolete pair of pragmas
	Warnings Off / On.
	* output.adb: Remove now obsolete pair of pragmas Warnings Off / On.
	* sem_warn.adb (Warn_On_Constant_Valid_Condition): Do not
	consider comparisons between static expressions because their
	values cannot be invalidated.
	* urealp.adb (Tree_Read): Remove now obsolete pair of pragmas
	Warnings Off / On.
	(Tree_Write): Remove now obsolete pair of pragmas Warnings Off / On.
	* usage.adb Remove now obsolete pair of pragmas Warnings Off / On.

2017-04-25  Bob Duff  <duff@adacore.com>

	* sem_elab.adb (In_Task_Activation): Trace internal calls in
	task bodies.

From-SVN: r247227

12 files changed, 135 insertions, 135 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 4979727..49eeadb 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,36 @@
+2017-04-25  Thomas Quinot  <quinot@adacore.com>
+
+	* sem_prag.adb (Analyze_Pragma, case Pragma_Check): Remove
+	bogus circuitry for the case where Name is Predicate.
+
+2017-04-25  Thomas Quinot  <quinot@adacore.com>
+
+	* par_sco.adb(Traverse_Declarations_Or_Statements.Traverse_Aspects):
+	Create SCOs for Predicate aspects in disabled
+	state initially, to be enabled later on by...
+	* sem_ch13.adb (Build_Predicate_Functions.Add_Predicates): Mark
+	SCO for predicate as enabled.
+
+2017-04-25  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* comperr.adb (Compiler_Abort): Remove now obsolete pair of
+	pragmas Warnings Off / On.
+	* namet.adb (Finalize): Remove now obsolete pair of pragmas
+	Warnings Off / On.
+	* output.adb: Remove now obsolete pair of pragmas Warnings Off / On.
+	* sem_warn.adb (Warn_On_Constant_Valid_Condition): Do not
+	consider comparisons between static expressions because their
+	values cannot be invalidated.
+	* urealp.adb (Tree_Read): Remove now obsolete pair of pragmas
+	Warnings Off / On.
+	(Tree_Write): Remove now obsolete pair of pragmas Warnings Off / On.
+	* usage.adb Remove now obsolete pair of pragmas Warnings Off / On.
+
+2017-04-25  Bob Duff  <duff@adacore.com>
+
+	* sem_elab.adb (In_Task_Activation): Trace internal calls in
+	task bodies.
+
 2017-04-25  Gary Dismukes  <dismukes@adacore.com>
 
 	* sem_prag.adb, sem_warn.adb, sem_eval.adb: Minor reformatting and
diff --git a/gcc/ada/comperr.adb b/gcc/ada/comperr.adb
index b3e20a4..0403524 100644
--- a/gcc/ada/comperr.adb
+++ b/gcc/ada/comperr.adb
@@ -98,18 +98,9 @@ package body Comperr is
          Write_Eol;
       end End_Line;
 
-      --  Disable the warnings emitted by -gnatwc because the following two
-      --  constants are initialized by means of conditional compilation.
-
-      pragma Warnings
-        (Off, "condition can only be * if invalid values present");
-
       Is_GPL_Version : constant Boolean := Gnatvsn.Build_Type = GPL;
       Is_FSF_Version : constant Boolean := Gnatvsn.Build_Type = FSF;
 
-      pragma Warnings
-        (On, "condition can only be * if invalid values present");
-
    --  Start of processing for Compiler_Abort
 
    begin
diff --git a/gcc/ada/namet.adb b/gcc/ada/namet.adb
index a161046..6b9f61d 100644
--- a/gcc/ada/namet.adb
+++ b/gcc/ada/namet.adb
@@ -672,12 +672,6 @@ package body Namet is
                   Max_Chain_Length := C;
                end if;
 
-               --  Disable the warnings emitted by -gnatwc because the tests
-               --  involving Verbosity involve conditional compilation.
-
-               pragma Warnings
-                 (Off, "condition can only be * if invalid values present");
-
                if Verbosity >= 2 then
                   Write_Str ("Hash_Table (");
                   Write_Int (J);
@@ -709,9 +703,6 @@ package body Namet is
                      N := Name_Entries.Table (N).Hash_Link;
                   end loop;
                end if;
-
-               pragma Warnings
-                 (On, "condition can only be * if invalid values present");
             end;
          end if;
       end loop;
diff --git a/gcc/ada/output.adb b/gcc/ada/output.adb
index 34e54d8..33a0805 100644
--- a/gcc/ada/output.adb
+++ b/gcc/ada/output.adb
@@ -55,12 +55,7 @@ package body Output is
    Indentation_Limit : constant Positive := 40;
    --  Indentation beyond this number of spaces wraps around
 
-   --  Disable the warnings emitted by -gnatwc because the comparison within
-   --  the assertion depends on conditional compilation.
-
-   pragma Warnings (Off, "condition can only be * if invalid values present");
    pragma Assert (Indentation_Limit < Buffer_Max / 2);
-   pragma Warnings (On,  "condition can only be * if invalid values present");
    --  Make sure this is substantially shorter than the line length
 
    Cur_Indentation : Natural := 0;
diff --git a/gcc/ada/par_sco.adb b/gcc/ada/par_sco.adb
index a3379dd..e5bb42a 100644
--- a/gcc/ada/par_sco.adb
+++ b/gcc/ada/par_sco.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2009-2016, Free Software Foundation, Inc.         --
+--          Copyright (C) 2009-2017, 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- --
@@ -1678,7 +1678,15 @@ package body Par_SCO is
                --  Aspects rewritten into pragmas controlled by a Check_Policy:
                --  Current_Pragma_Sloc must be set to the sloc of the aspect
                --  specification. The corresponding pragma will have the same
-               --  sloc.
+               --  sloc. Note that Invariant, Pre, and Post will be enabled if
+               --  the policy is Check; on the other hand, predicate aspects
+               --  will be enabled for Check and Ignore (when Add_Predicate
+               --  is called) because the actual checks occur in client units.
+               --  When the assertion policy for Predicate is Disable, the
+               --  SCO remains disabled, because Add_Predicate is never called.
+
+               --  Pre/post can have checks in client units too because of
+               --  inheritance, so should they receive the same treatment???
 
                when Aspect_Invariant
                   | Aspect_Post
@@ -1686,24 +1694,11 @@ package body Par_SCO is
                   | Aspect_Pre
                   | Aspect_Precondition
                   | Aspect_Type_Invariant
-               =>
-                  C1 := 'a';
-
-               --  Aspects whose checks are generated in client units,
-               --  regardless of whether or not the check is activated in the
-               --  unit which contains the declaration: create decision as
-               --  unconditionally enabled aspect (but still make a pragma
-               --  entry since Set_SCO_Pragma_Enabled will be called when
-               --  analyzing actual checks, possibly in other units).
-
-               --  Pre/post can have checks in client units too because of
-               --  inheritance, so should they be moved here???
-
-               when Aspect_Dynamic_Predicate
+                  | Aspect_Dynamic_Predicate
                   | Aspect_Predicate
                   | Aspect_Static_Predicate
                =>
-                  C1 := 'A';
+                  C1 := 'a';
 
                --  Other aspects: just process any decision nested in the
                --  aspect expression.
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index ca8a5cc..482eab4 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -42,6 +42,7 @@ with Namet;    use Namet;
 with Nlists;   use Nlists;
 with Nmake;    use Nmake;
 with Opt;      use Opt;
+with Par_SCO;  use Par_SCO;
 with Restrict; use Restrict;
 with Rident;   use Rident;
 with Rtsfind;  use Rtsfind;
@@ -8419,6 +8420,10 @@ package body Sem_Ch13 is
          --  Start of processing for Add_Predicate
 
          begin
+            --  Mark corresponding SCO as enabled
+
+            Set_SCO_Pragma_Enabled (Sloc (Prag));
+
             --  Extract the arguments of the pragma. The expression itself
             --  is copied for use in the predicate function, to preserve the
             --  original version for ASIS use.
diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb
index b4102ed..45241c3 100644
--- a/gcc/ada/sem_elab.adb
+++ b/gcc/ada/sem_elab.adb
@@ -70,26 +70,26 @@ package body Sem_Elab is
       Ent  : Entity_Id;
    end record;
 
-   package Elab_Call is new Table.Table (
-     Table_Component_Type => Elab_Call_Entry,
-     Table_Index_Type     => Int,
-     Table_Low_Bound      => 1,
-     Table_Initial        => 50,
-     Table_Increment      => 100,
-     Table_Name           => "Elab_Call");
+   package Elab_Call is new Table.Table
+     (Table_Component_Type => Elab_Call_Entry,
+      Table_Index_Type     => Int,
+      Table_Low_Bound      => 1,
+      Table_Initial        => 50,
+      Table_Increment      => 100,
+      Table_Name           => "Elab_Call");
 
    --  This table is initialized at the start of each outer level call. It
    --  holds the entities for all subprograms that have been examined for this
    --  particular outer level call, and is used to prevent both infinite
    --  recursion, and useless reanalysis of bodies already seen
 
-   package Elab_Visited is new Table.Table (
-     Table_Component_Type => Entity_Id,
-     Table_Index_Type     => Int,
-     Table_Low_Bound      => 1,
-     Table_Initial        => 200,
-     Table_Increment      => 100,
-     Table_Name           => "Elab_Visited");
+   package Elab_Visited is new Table.Table
+     (Table_Component_Type => Entity_Id,
+      Table_Index_Type     => Int,
+      Table_Low_Bound      => 1,
+      Table_Initial        => 200,
+      Table_Increment      => 100,
+      Table_Name           => "Elab_Visited");
 
    --  This table stores calls to Check_Internal_Call that are delayed until
    --  all generics are instantiated and in particular until after all generic
@@ -112,23 +112,29 @@ package body Sem_Elab is
       --  The current scope of the call. This is restored when we complete the
       --  delayed call, so that we do this in the right scope.
 
-      From_SPARK_Code : Boolean;
-      --  Save indication of whether this call is under SPARK_Mode => On
+      Outer_Scope : Entity_Id;
+      --  Save scope of outer level call
 
       From_Elab_Code : Boolean;
       --  Save indication of whether this call is from elaboration code
 
-      Outer_Scope : Entity_Id;
-      --  Save scope of outer level call
+      In_Task_Activation : Boolean;
+      --  Save indication of whether this call is from a task body. Tasks are
+      --  activated at the "begin", which is after all local procedure bodies,
+      --  so calls to those procedures can't fail, even if they occur after the
+      --  task body.
+
+      From_SPARK_Code : Boolean;
+      --  Save indication of whether this call is under SPARK_Mode => On
    end record;
 
-   package Delay_Check is new Table.Table (
-     Table_Component_Type => Delay_Element,
-     Table_Index_Type     => Int,
-     Table_Low_Bound      => 1,
-     Table_Initial        => 1000,
-     Table_Increment      => 100,
-     Table_Name           => "Delay_Check");
+   package Delay_Check is new Table.Table
+     (Table_Component_Type => Delay_Element,
+      Table_Index_Type     => Int,
+      Table_Low_Bound      => 1,
+      Table_Initial        => 1000,
+      Table_Increment      => 100,
+      Table_Name           => "Delay_Check");
 
    C_Scope : Entity_Id;
    --  Top-level scope of current scope. Compute this only once at the outer
@@ -145,10 +151,12 @@ package body Sem_Elab is
    --  routines in other units if this flag is True.
 
    In_Task_Activation : Boolean := False;
-   --  This flag indicates whether we are performing elaboration checks on
-   --  task procedures, at the point of activation. If true, we do not trace
-   --  internal calls in these procedures, because all local bodies are known
-   --  to be elaborated.
+   --  This flag indicates whether we are performing elaboration checks on task
+   --  bodies, at the point of activation. If true, we do not raise
+   --  Program_Error for calls to local procedures, because all local bodies
+   --  are known to be elaborated. However, we still need to trace such calls,
+   --  because a local procedure could call a procedure in another package,
+   --  so we might need an implicit Elaborate_All.
 
    Delaying_Elab_Checks : Boolean := True;
    --  This is set True till the compilation is complete, including the
@@ -242,7 +250,7 @@ package body Sem_Elab is
       Orig_Ent    : Entity_Id);
    --  The processing for Check_Internal_Call is divided up into two phases,
    --  and this represents the second phase. The second phase is delayed if
-   --  Delaying_Elab_Calls is set to True. In this delayed case, the first
+   --  Delaying_Elab_Checks is set to True. In this delayed case, the first
    --  phase makes an entry in the Delay_Check table, which is processed when
    --  Check_Elab_Calls is called. N, E and Orig_Ent are as for the call to
    --  Check_Internal_Call. Outer_Scope is the outer level scope for the
@@ -1956,6 +1964,7 @@ package body Sem_Elab is
          for J in Delay_Check.First .. Delay_Check.Last loop
             Push_Scope (Delay_Check.Table (J).Curscop);
             From_Elab_Code := Delay_Check.Table (J).From_Elab_Code;
+            In_Task_Activation := Delay_Check.Table (J).In_Task_Activation;
 
             --  Set appropriate value of SPARK_Mode
 
@@ -1965,11 +1974,11 @@ package body Sem_Elab is
                SPARK_Mode := On;
             end if;
 
-            Check_Internal_Call_Continue (
-              N           => Delay_Check.Table (J).N,
-              E           => Delay_Check.Table (J).E,
-              Outer_Scope => Delay_Check.Table (J).Outer_Scope,
-              Orig_Ent    => Delay_Check.Table (J).Orig_Ent);
+            Check_Internal_Call_Continue
+              (N           => Delay_Check.Table (J).N,
+               E           => Delay_Check.Table (J).E,
+               Outer_Scope => Delay_Check.Table (J).Outer_Scope,
+               Orig_Ent    => Delay_Check.Table (J).Orig_Ent);
 
             SPARK_Mode := Save_SPARK_Mode;
             Pop_Scope;
@@ -2201,12 +2210,6 @@ package body Sem_Elab is
       elsif Is_Intrinsic_Subprogram (E) then
          return;
 
-      --  No need to trace local calls if checking task activation, because
-      --  other local bodies are elaborated already.
-
-      elsif In_Task_Activation then
-         return;
-
       --  Nothing to do if call is within a generic unit
 
       elsif Inside_A_Generic then
@@ -2224,14 +2227,15 @@ package body Sem_Elab is
       --  Delay this call if we are still delaying calls
 
       if Delaying_Elab_Checks then
-         Delay_Check.Append (
-           (N               => N,
-            E               => E,
-            Orig_Ent        => Orig_Ent,
-            Curscop         => Current_Scope,
-            Outer_Scope     => Outer_Scope,
-            From_Elab_Code  => From_Elab_Code,
-            From_SPARK_Code => SPARK_Mode = On));
+         Delay_Check.Append
+           ((N                  => N,
+             E                  => E,
+             Orig_Ent           => Orig_Ent,
+             Curscop            => Current_Scope,
+             Outer_Scope        => Outer_Scope,
+             From_Elab_Code     => From_Elab_Code,
+             In_Task_Activation => In_Task_Activation,
+             From_SPARK_Code    => SPARK_Mode = On));
          return;
 
       --  Otherwise, call phase 2 continuation right now
@@ -2520,7 +2524,10 @@ package body Sem_Elab is
             --  inserted.
 
          begin
-            if Inst_Case then
+            if In_Task_Activation then
+               Insert_Check := False;
+
+            elsif Inst_Case then
                Error_Msg_NE
                  ("cannot instantiate& before body seen<<", N, Orig_Ent);
 
diff --git a/gcc/ada/sem_elab.ads b/gcc/ada/sem_elab.ads
index 7fbb2f6..3db19da 100644
--- a/gcc/ada/sem_elab.ads
+++ b/gcc/ada/sem_elab.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1997-2015, Free Software Foundation, Inc.         --
+--          Copyright (C) 1997-2017, 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- --
@@ -132,7 +132,7 @@ package Sem_Elab is
    --  N_Function_Call or N_Procedure_Call_Statement node or an access
    --  attribute reference whose prefix is a subprogram.
    --
-   --  If SPARK_Mode is On, then N can also be a variablr reference, since
+   --  If SPARK_Mode is On, then N can also be a variable reference, since
    --  SPARK requires the use of Elaborate_All for references to variables
    --  in other packages.
 
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index a3c5d14..1336625 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -12756,22 +12756,9 @@ package body Sem_Prag is
 
             --  Deal with SCO generation
 
-            case Cname is
-
-               --  Nothing to do for predicates as the checks occur in the
-               --  client units. The SCO for the aspect in the declaration
-               --  unit is conservatively always enabled.
-
-               when Name_Predicate =>
-                  null;
-
-               --  Otherwise mark aspect/pragma SCO as enabled
-
-               when others =>
-                  if Is_Checked (N) and then not Split_PPC (N) then
-                     Set_SCO_Pragma_Enabled (Loc);
-                  end if;
-            end case;
+            if Is_Checked (N) and then not Split_PPC (N) then
+               Set_SCO_Pragma_Enabled (Loc);
+            end if;
 
             --  Deal with analyzing the string argument
 
diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb
index d4f3e4f..52fc372 100644
--- a/gcc/ada/sem_warn.adb
+++ b/gcc/ada/sem_warn.adb
@@ -3267,22 +3267,39 @@ package body Sem_Warn is
    --------------------------------------
 
    procedure Warn_On_Constant_Valid_Condition (Op : Node_Id) is
+      Left  : constant Node_Id := Left_Opnd  (Op);
+      Right : constant Node_Id := Right_Opnd (Op);
+
       True_Result  : Boolean;
       False_Result : Boolean;
 
    begin
       --  Determine the potential outcome of the comparison assuming that the
-      --  operands are valid. Do not consider instances because the check was
-      --  already performed in the generic. Do not consider comparison between
-      --  an attribute reference and a compile-time known value since this is
-      --  most likely a conditional compilation. Do not consider internal files
-      --  in order to allow for various assertions and safeguards within our
-      --  runtime.
+      --  operands are valid.
 
       if Constant_Condition_Warnings
         and then Comes_From_Source (Original_Node (Op))
+
+        --  Do not consider instances because the check was already performed
+        --  in the generic.
+
         and then not In_Instance
+
+        --  Do not consider comparisons between two static expressions such as
+        --  constants or literals because those values cannot be invalidated.
+
+        and then not (Is_Static_Expression (Left)
+                       and then Is_Static_Expression (Right))
+
+        --  Do not consider comparison between an attribute reference and a
+        --  compile-time known value since this is most likely a conditional
+        --  compilation.
+
         and then not Is_Attribute_And_Known_Value_Comparison (Op)
+
+        --  Do not consider internal files to allow for various assertions and
+        --  safeguards within our runtime.
+
         and then not Is_Internal_File_Name
                        (Unit_File_Name (Get_Source_Unit (Op)))
       then
diff --git a/gcc/ada/urealp.adb b/gcc/ada/urealp.adb
index 5aaee7d..b408d01 100644
--- a/gcc/ada/urealp.adb
+++ b/gcc/ada/urealp.adb
@@ -493,14 +493,7 @@ package body Urealp is
 
    procedure Tree_Read is
    begin
-      --  Disable the warnings emitted by -gnatwc because the following check
-      --  acts as a signal in case Num_Ureal_Constants is changed.
-
-      pragma Warnings
-        (Off, "condition can only be * if invalid values present");
       pragma Assert (Num_Ureal_Constants = 10);
-      pragma Warnings
-        (On,  "condition can only be * if invalid values present");
 
       Ureals.Tree_Read;
       Tree_Read_Int (Int (UR_0));
@@ -525,14 +518,7 @@ package body Urealp is
 
    procedure Tree_Write is
    begin
-      --  Disable the warnings emitted by -gnatwc because the following check
-      --  acts as a signal in case Num_Ureal_Constants is changed.
-
-      pragma Warnings
-        (Off, "condition can only be * if invalid values present");
       pragma Assert (Num_Ureal_Constants = 10);
-      pragma Warnings
-        (On,  "condition can only be * if invalid values present");
 
       Ureals.Tree_Write;
       Tree_Write_Int (Int (UR_0));
diff --git a/gcc/ada/usage.adb b/gcc/ada/usage.adb
index 8a47fd6..8eb362f 100644
--- a/gcc/ada/usage.adb
+++ b/gcc/ada/usage.adb
@@ -671,11 +671,6 @@ begin
    Write_Switch_Char ("zr");
    Write_Line ("Distribution stub generation for receiver stubs");
 
-   --  Disable the warnings emitted by -gnatwc because Ada_Version_Default may
-   --  be changed to denote a different default value.
-
-   pragma Warnings (Off, "condition can only be * if invalid values present");
-
    if not Latest_Ada_Only then
 
       --  Line for -gnat83 switch
@@ -714,8 +709,6 @@ begin
       Write_Line ("Ada 2012 mode");
    end if;
 
-   pragma Warnings (On, "condition can only be * if invalid values present");
-
    --  Line for -gnat-p switch
 
    Write_Switch_Char ("-p");