-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
-- 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;
-- If we fall through entry was not found
- Check_Num := 0;
return;
end Find_Check;
-- 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
------------------------------------------------------------------------------
with Atree; use Atree;
+with Debug; use Debug;
with Einfo; use Einfo;
with Elists; use Elists;
with Errout; use Errout;
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;
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);
-- 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
-- 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
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
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 --
-------------------------
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
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.
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
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
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))
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 --
-------------------------
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 --
----------------------------
-- 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
-- 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.
OSDN Git Service
