From: charlet Date: Mon, 27 Jul 2009 13:20:37 +0000 (+0000) Subject: 2009-07-27 Robert Dewar X-Git-Url: http://git.sourceforge.jp/view?a=commitdiff_plain;h=ed1955558aba1fc7929d187428212e81843a0b93;p=pf3gnuchains%2Fgcc-fork.git 2009-07-27 Robert Dewar * 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 * 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. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@150110 138bc75d-0d04-0410-961f-82ee72b054a4 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index fba1a74a6c1..8185d034751 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,4 +1,21 @@ -2009-07-16 Dave Korn +2009-07-27 Robert Dewar + + * 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 + + * 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 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 e39e3e079a6..d1a2b460c90 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 baa04293cd1..f60a67b5b40 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 5d1822d1859..9d475e2ca6a 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 f6a83bd2f91..c326916476c 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 199e3ffb8da..3798ac74a7a 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 6513e73d073..c1b3a331892 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 b96b9d9ba38..ff8dd6e5253 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 385337a99bb..eb3ec12d5ec 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 8cd32783e1a..11abc976d2c 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 aa3958f8b4f..4948c51845d 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.