[multiple changes]

2009-07-27  Robert Dewar  <dewar@adacore.com>

	* exp_ch6.adb (Expand_Call): Reset Is_Known_Valid after call

	* sem_ch3.adb, sem_eval.adb, sem_aux.adb: Minor comment reformatting

2009-07-27  Geert Bosch  <bosch@adacore.com>

	* checks.adb (Find_Check): Minor streamlining of logic.
	* gnat1drv.adb(Gnat1drv): Put Check_Rep_Info in its alphabetical order.
	* debug.adb: Document -gnatdX debug flag
	* exp_ch2.adb(Expand_Entity_Reference): Implement new -gnatdX flag to
	list information about reads from scalar entities.
	Also slightly simplify condition for Expand_Current_Value.
	* sem_util.ads, sem_util.adb (Is_LHS, Is_Actual_Out_Parameter): New
	functions.

From-SVN: r150110

11 files changed, 114 insertions, 40 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index fba1a74..8185d03 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,4 +1,21 @@
-2009-07-16  Dave Korn  <dave.korn.cygwin@gmail.com>
+2009-07-27  Robert Dewar  <dewar@adacore.com>
+
+	* exp_ch6.adb (Expand_Call): Reset Is_Known_Valid after call
+
+	* sem_ch3.adb, sem_eval.adb, sem_aux.adb: Minor comment reformatting
+
+2009-07-27  Geert Bosch  <bosch@adacore.com>
+
+	* checks.adb (Find_Check): Minor streamlining of logic.
+	* gnat1drv.adb(Gnat1drv): Put Check_Rep_Info in its alphabetical order.
+	* debug.adb: Document -gnatdX debug flag
+	* exp_ch2.adb(Expand_Entity_Reference): Implement new -gnatdX flag to
+	list information about reads from scalar entities.
+	Also slightly simplify condition for Expand_Current_Value.
+	* sem_util.ads, sem_util.adb (Is_LHS, Is_Actual_Out_Parameter): New
+	functions.
+
+2009-07-26  Dave Korn  <dave.korn.cygwin@gmail.com>
 
 	PR bootstrap/40578
 	* adaint.h (FOPEN, STAT, FSTAT, LSTAT, STRUCT_STAT): Rename from these
diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index e39e3e07..d1a2b46 100644
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -4254,7 +4254,7 @@ package body Checks is
    --  Start of processing for Find_Check
 
    begin
-      --  Establish default, to avoid warnings from GCC
+      --  Establish default, in case no entry is found
 
       Check_Num := 0;
 
@@ -4325,7 +4325,6 @@ package body Checks is
 
       --  If we fall through entry was not found
 
-      Check_Num := 0;
       return;
    end Find_Check;
 
diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb
index baa0429..f60a67b 100644
--- a/gcc/ada/debug.adb
+++ b/gcc/ada/debug.adb
@@ -87,7 +87,7 @@ package body Debug is
    --  dU   Enable garbage collection of unreachable entities
    --  dV   Enable viewing of all symbols in debugger
    --  dW   Disable warnings on calls for IN OUT parameters
-   --  dX
+   --  dX   Display messages on reads of potentially uninitialized scalars
    --  dY   Enable configurable run-time mode
    --  dZ   Generate listing showing the contents of the dispatch tables
 
diff --git a/gcc/ada/exp_ch2.adb b/gcc/ada/exp_ch2.adb
index 5d1822d..9d475e2 100644
--- a/gcc/ada/exp_ch2.adb
+++ b/gcc/ada/exp_ch2.adb
@@ -24,6 +24,7 @@
 ------------------------------------------------------------------------------
 
 with Atree;    use Atree;
+with Debug;    use Debug;
 with Einfo;    use Einfo;
 with Elists;   use Elists;
 with Errout;   use Errout;
@@ -34,12 +35,14 @@ with Exp_VFpt; use Exp_VFpt;
 with Namet;    use Namet;
 with Nmake;    use Nmake;
 with Opt;      use Opt;
+with Output;   use Output;
 with Sem;      use Sem;
 with Sem_Eval; use Sem_Eval;
 with Sem_Res;  use Sem_Res;
 with Sem_Util; use Sem_Util;
 with Sem_Warn; use Sem_Warn;
 with Sinfo;    use Sinfo;
+with Sinput;   use Sinput;
 with Snames;   use Snames;
 with Tbuild;   use Tbuild;
 with Uintp;    use Uintp;
@@ -370,13 +373,32 @@ package body Exp_Ch2 is
          Expand_Shared_Passive_Variable (N);
       end if;
 
+      --  Test code for implementing the pragma Reviewable requirement of
+      --  classifying reads of scalars as referencing potentially uninitialized
+      --  objects or not.
+
+      if Debug_Flag_XX
+        and then Is_Scalar_Type (Etype (N))
+        and then (Is_Assignable (E) or else Is_Constant_Object (E))
+        and then Comes_From_Source (N)
+        and then not Is_LHS (N)
+        and then not Is_Actual_Out_Parameter (N)
+        and then (Nkind (Parent (N)) /= N_Attribute_Reference
+                  or else Attribute_Name (Parent (N)) /= Name_Valid)
+      then
+         Write_Location (Sloc (N));
+         Write_Str (": Read from scalar """);
+         Write_Name (Chars (N));
+         Write_Str ("""");
+         if Is_Known_Valid (E) then
+            Write_Str (", Is_Known_Valid");
+         end if;
+         Write_Eol;
+      end if;
+
       --  Interpret possible Current_Value for variable case
 
-      if (Ekind (E) = E_Variable
-            or else
-          Ekind (E) = E_In_Out_Parameter
-            or else
-          Ekind (E) = E_Out_Parameter)
+      if Is_Assignable (E)
         and then Present (Current_Value (E))
       then
          Expand_Current_Value (N);
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index f6a83bd..c326916 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -1125,6 +1125,7 @@ package body Exp_Ch6 is
             --  created, since we just passed it as an OUT parameter.
 
             Kill_Current_Values (Temp);
+            Set_Is_Known_Valid (Temp, False);
 
             --  If type conversion, use reverse conversion on exit
 
@@ -2470,7 +2471,8 @@ package body Exp_Ch6 is
                --  For an OUT or IN OUT parameter that is an assignable entity,
                --  we do not want to clobber the Last_Assignment field, since
                --  if it is set, it was precisely because it is indeed an OUT
-               --  or IN OUT parameter!
+               --  or IN OUT parameter! We do reset the Is_Known_Valid flag
+               --  since the subprogram could have returned in invalid value.
 
                if (Ekind (Formal) = E_Out_Parameter
                      or else
@@ -2480,6 +2482,7 @@ package body Exp_Ch6 is
                   Sav := Last_Assignment (Ent);
                   Kill_Current_Values (Ent);
                   Set_Last_Assignment (Ent, Sav);
+                  Set_Is_Known_Valid (Ent, False);
 
                   --  For all other cases, just kill the current values
 
diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb
index 199e3ff..3798ac7 100644
--- a/gcc/ada/gnat1drv.adb
+++ b/gcc/ada/gnat1drv.adb
@@ -460,25 +460,6 @@ procedure Gnat1drv is
       end if;
    end Check_Bad_Body;
 
-   --------------------
-   -- Check_Rep_Info --
-   --------------------
-
-   procedure Check_Rep_Info is
-   begin
-      if List_Representation_Info /= 0
-        or else List_Representation_Info_Mechanisms
-      then
-         Set_Standard_Error;
-         Write_Eol;
-         Write_Str
-           ("cannot generate representation information, no code generated");
-         Write_Eol;
-         Write_Eol;
-         Set_Standard_Output;
-      end if;
-   end Check_Rep_Info;
-
    -------------------------
    -- Check_Library_Items --
    -------------------------
@@ -508,6 +489,25 @@ procedure Gnat1drv is
       Walk;
    end Check_Library_Items;
 
+   --------------------
+   -- Check_Rep_Info --
+   --------------------
+
+   procedure Check_Rep_Info is
+   begin
+      if List_Representation_Info /= 0
+        or else List_Representation_Info_Mechanisms
+      then
+         Set_Standard_Error;
+         Write_Eol;
+         Write_Str
+           ("cannot generate representation information, no code generated");
+         Write_Eol;
+         Write_Eol;
+         Set_Standard_Output;
+      end if;
+   end Check_Rep_Info;
+
 --  Start of processing for Gnat1drv
 
 begin
diff --git a/gcc/ada/sem_aux.adb b/gcc/ada/sem_aux.adb
index 6513e73..c1b3a33 100755
--- a/gcc/ada/sem_aux.adb
+++ b/gcc/ada/sem_aux.adb
@@ -312,11 +312,11 @@ package body Sem_Aux is
       Ent : Entity_Id;
 
    begin
-      --  If the base type has no freeze node, it is a type in standard,
+      --  If the base type has no freeze node, it is a type in Standard,
       --  and always acts as its own first subtype unless it is one of the
       --  predefined integer types. If the type is formal, it is also a first
       --  subtype, and its base type has no freeze node. On the other hand, a
-      --  subtype of a generic formal is not its own first_subtype. Its base
+      --  subtype of a generic formal is not its own first subtype. Its base
       --  type, if anonymous, is attached to the formal type decl. from which
       --  the first subtype is obtained.
 
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index b96b9d9..ff8dd6e 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -2588,8 +2588,8 @@ package body Sem_Ch3 is
            and then Is_Access_Constant (Etype (E))
          then
             Error_Msg_N
-              ("access to variable cannot be initialized " &
-                "with an access-to-constant expression", E);
+              ("access to variable cannot be initialized "
+               & "with an access-to-constant expression", E);
          end if;
 
          if not Assignment_OK (N) then
@@ -2598,10 +2598,9 @@ package body Sem_Ch3 is
 
          Check_Unset_Reference (E);
 
-         --  If this is a variable, then set current value.
-         --  If this is a declared constant of a scalar type
-         --  with a static expression, indicate that it is
-         --  always valid.
+         --  If this is a variable, then set current value. If this is a
+         --  declared constant of a scalar type with a static expression,
+         --  indicate that it is always valid.
 
          if not Constant_Present (N) then
             if Compile_Time_Known_Value (E) then
diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb
index 385337a..eb3ec12 100644
--- a/gcc/ada/sem_eval.adb
+++ b/gcc/ada/sem_eval.adb
@@ -886,13 +886,15 @@ package body Sem_Eval is
                  and then LLo = RLo
                then
 
-                  --  if the range includes a single literal and we
-                  --  can assume validity then the result is known
-                  --  even if an operand is not static.
+                  --  If the range includes a single literal and we can assume
+                  --  validity then the result is known even if an operand is
+                  --  not static.
 
                   if Assume_Valid then
                      return EQ;
 
+                  --  Comment here ???
+
                   elsif Is_Entity_Name (L)
                     and then Is_Entity_Name (R)
                     and then Is_Known_Valid (Entity (L))
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 8cd3278..11abc97 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -5334,6 +5334,20 @@ package body Sem_Util is
          and then E = Base_Type (E);
    end Is_AAMP_Float;
 
+   -----------------------------
+   -- Is_Actual_Out_Parameter --
+   -----------------------------
+
+   function Is_Actual_Out_Parameter (N : Node_Id) return Boolean is
+      Formal : Entity_Id;
+      Call   : Node_Id;
+   begin
+      Find_Actual (N, Formal, Call);
+
+      return Present (Formal)
+        and then Ekind (Formal) = E_Out_Parameter;
+   end Is_Actual_Out_Parameter;
+
    -------------------------
    -- Is_Actual_Parameter --
    -------------------------
@@ -6113,6 +6127,17 @@ package body Sem_Util is
       end if;
    end Is_Fully_Initialized_Variant;
 
+   ------------
+   -- Is_LHS --
+   ------------
+
+   function Is_LHS (N : Node_Id) return Boolean is
+      P    : constant Node_Id := Parent (N);
+   begin
+      return Nkind (P) = N_Assignment_Statement
+        and then Name (P) = N;
+   end Is_LHS;
+
    ----------------------------
    -- Is_Inherited_Operation --
    ----------------------------
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index aa3958f..4948c51 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -629,6 +629,9 @@ package Sem_Util is
    --  the dependency of Einfo on Targparm which would be required for a
    --  synthesized attribute.
 
+   function Is_Actual_Out_Parameter (N : Node_Id) return Boolean;
+   --  Determines if N is an actual parameter of out mode in a subprogram call
+
    function Is_Actual_Parameter (N : Node_Id) return Boolean;
    --  Determines if N is an actual parameter in a subprogram call
 
@@ -703,6 +706,10 @@ package Sem_Util is
    --  E is a subprogram. Return True is E is an implicit operation inherited
    --  by a derived type declarations.
 
+   function Is_LHS (N : Node_Id) return Boolean;
+   --  Returns True iff N is an identifier used as Name in an assignment
+   --  statement.
+
    function Is_Library_Level_Entity (E : Entity_Id) return Boolean;
    --  A library-level declaration is one that is accessible from Standard,
    --  i.e. a library unit or an entity declared in a library package.