From 84df40f7680c388bdb85cd859021013dd5c34197 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 1 Aug 2011 15:23:32 +0200 Subject: [PATCH] [multiple changes] 2011-08-01 Geert Bosch * par-ch3.adb (P_Discrete_Choice_List): Improve error message for extra "," in choice list. 2011-08-01 Thomas Quinot * exp_ch11.adb (Expand_N_Raise_Statement): Mark N_Raise_xxx_Error for explicit raise of a predefined exception as Comes_From_Source if the original N_Raise_Statement comes from source. 2011-08-01 Robert Dewar * sinfo.ads: Add comment. * sem_ch6.adb: Minor reformatting. 2011-08-01 Robert Dewar * freeze.adb (Freeze_Entity): Refine check for bad component size clause to avoid rejecting confirming clause when atomic/aliased present. 2011-08-01 Ed Schonberg * sem_ch8.adb (Find_Direct_Name, Analyze_Expanded_Name): use Is_LHS to better determine whether an entity reference is a write. * sem_util.adb (Is_LHS): refine predicate to handle assignment to a subcomponent. * lib-xref.adb (Output_References): Do no suppress a read reference at the same location as an immediately preceeding modify-reference, to handle properly in-out actuals. 2011-08-01 Tristan Gingold * env.c (__gnat_setenv) [VMS]: Refine previous change. 2011-08-01 Quentin Ochem * i-cstrin.adb (New_String): Changed implementation, now uses only the heap to compute the result. From-SVN: r177029 --- gcc/ada/ChangeLog | 40 ++++++++++++++++++++++++++++++++++++++++ gcc/ada/env.c | 5 ++++- gcc/ada/exp_ch11.adb | 27 +++++++++++++++------------ gcc/ada/freeze.adb | 24 ++++++++++++++++++++---- gcc/ada/i-cstrin.adb | 20 ++++++++++++++++++-- gcc/ada/lib-xref.adb | 13 +++++++++++-- gcc/ada/par-ch3.adb | 16 +++++++++++++--- gcc/ada/sem_ch6.adb | 8 ++++---- gcc/ada/sem_ch8.adb | 20 ++++++++++++++++++-- gcc/ada/sem_util.adb | 13 +++++++++++-- gcc/ada/sinfo.ads | 7 +++++++ 11 files changed, 161 insertions(+), 32 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index cabde818272..1f243eb503d 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,43 @@ +2011-08-01 Geert Bosch + + * par-ch3.adb (P_Discrete_Choice_List): Improve error message for extra + "," in choice list. + +2011-08-01 Thomas Quinot + + * exp_ch11.adb (Expand_N_Raise_Statement): Mark N_Raise_xxx_Error for + explicit raise of a predefined exception as Comes_From_Source if the + original N_Raise_Statement comes from source. + +2011-08-01 Robert Dewar + + * sinfo.ads: Add comment. + * sem_ch6.adb: Minor reformatting. + +2011-08-01 Robert Dewar + + * freeze.adb (Freeze_Entity): Refine check for bad component size + clause to avoid rejecting confirming clause when atomic/aliased present. + +2011-08-01 Ed Schonberg + + * sem_ch8.adb (Find_Direct_Name, Analyze_Expanded_Name): use Is_LHS to + better determine whether an entity reference is a write. + * sem_util.adb (Is_LHS): refine predicate to handle assignment to a + subcomponent. + * lib-xref.adb (Output_References): Do no suppress a read reference at + the same location as an immediately preceeding modify-reference, to + handle properly in-out actuals. + +2011-08-01 Tristan Gingold + + * env.c (__gnat_setenv) [VMS]: Refine previous change. + +2011-08-01 Quentin Ochem + + * i-cstrin.adb (New_String): Changed implementation, now uses only the + heap to compute the result. + 2011-08-01 Robert Dewar * atree.ads: Minor reformatting. diff --git a/gcc/ada/env.c b/gcc/ada/env.c index 8115442cc9a..e83a051921b 100644 --- a/gcc/ada/env.c +++ b/gcc/ada/env.c @@ -50,7 +50,6 @@ extern "C" { #include #ifdef VMS #include -#include #endif #if defined (__MINGW32__) @@ -74,6 +73,10 @@ extern char** ppGlobalEnviron; #include #endif +#ifdef VMS +#include +#endif + #include "env.h" void diff --git a/gcc/ada/exp_ch11.adb b/gcc/ada/exp_ch11.adb index 80d1d8d6998..726af2191bc 100644 --- a/gcc/ada/exp_ch11.adb +++ b/gcc/ada/exp_ch11.adb @@ -1439,6 +1439,7 @@ package body Exp_Ch11 is E : Entity_Id; Str : String_Id; H : Node_Id; + Src : Boolean; begin -- Processing for locally handled exception (exclude reraise case) @@ -1510,12 +1511,12 @@ package body Exp_Ch11 is return; end if; - -- Remaining processing is for the case where no string expression - -- is present. + -- Remaining processing is for the case where no string expression is + -- present. - -- Don't expand a raise statement that does not come from source - -- if we have already had configurable run-time violations, since - -- most likely it will be junk cascaded nonsense. + -- Don't expand a raise statement that does not come from source if we + -- have already had configurable run-time violations, since most likely + -- it will be junk cascaded nonsense. if Configurable_Run_Time_Violations > 0 and then not Comes_From_Source (N) @@ -1526,27 +1527,29 @@ package body Exp_Ch11 is -- Convert explicit raise of Program_Error, Constraint_Error, and -- Storage_Error into the corresponding raise (in High_Integrity_Mode -- all other raises will get normal expansion and be disallowed, - -- but this is also faster in all modes). + -- but this is also faster in all modes). Propagate Comes_From_Source + -- flag to the new node. if Present (Name (N)) and then Nkind (Name (N)) = N_Identifier then + Src := Comes_From_Source (N); if Entity (Name (N)) = Standard_Constraint_Error then Rewrite (N, - Make_Raise_Constraint_Error (Loc, - Reason => CE_Explicit_Raise)); + Make_Raise_Constraint_Error (Loc, Reason => CE_Explicit_Raise)); + Set_Comes_From_Source (N, Src); Analyze (N); return; elsif Entity (Name (N)) = Standard_Program_Error then Rewrite (N, - Make_Raise_Program_Error (Loc, - Reason => PE_Explicit_Raise)); + Make_Raise_Program_Error (Loc, Reason => PE_Explicit_Raise)); + Set_Comes_From_Source (N, Src); Analyze (N); return; elsif Entity (Name (N)) = Standard_Storage_Error then Rewrite (N, - Make_Raise_Storage_Error (Loc, - Reason => SE_Explicit_Raise)); + Make_Raise_Storage_Error (Loc, Reason => SE_Explicit_Raise)); + Set_Comes_From_Source (N, Src); Analyze (N); return; end if; diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 56fd5c52d02..3ecc13e6432 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -3447,12 +3447,28 @@ package body Freeze is -- Start of processing for Alias_Atomic_Check begin - -- Case where component size has no effect + -- Case where component size has no effect. First + -- check for object size of component type known + -- and a multiple of the storage unit size. if Known_Static_Esize (Ctyp) - and then Known_Static_RM_Size (Ctyp) - and then Esize (Ctyp) = RM_Size (Ctyp) - and then Esize (Ctyp) mod 8 = 0 + and then Esize (Ctyp) mod System_Storage_Unit = 0 + + -- OK in both packing case and component size case + -- if RM size is known and static and the same as + -- the object size. + + and then + ((Known_Static_RM_Size (Ctyp) + and then Esize (Ctyp) = RM_Size (Ctyp)) + + -- Or if we have an explicit component size + -- clause and the component size and object size + -- are equal. + + or else + (Has_Component_Size_Clause (E) + and then Component_Size (E) = Esize (Ctyp))) then null; diff --git a/gcc/ada/i-cstrin.adb b/gcc/ada/i-cstrin.adb index 8308649d5e8..ce74f4fafe4 100644 --- a/gcc/ada/i-cstrin.adb +++ b/gcc/ada/i-cstrin.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2010, 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- -- @@ -139,8 +139,24 @@ package body Interfaces.C.Strings is ---------------- function New_String (Str : String) return chars_ptr is + -- It's important that this subprogram uses directly the heap to compute + -- the result, and doesn't copy the string on the stack, otherwise its + -- use is limited when used from tasks on large strings. + + Result : constant chars_ptr := Memory_Alloc (Str'Length + 1); + Result_Array : char_array (1 .. Str'Length + 1); + for Result_Array'Address use To_Address (Result); + pragma Import (Ada, Result_Array); + + Count : size_t; begin - return New_Char_Array (To_C (Str)); + To_C + (Item => Str, + Target => Result_Array, + Count => Count, + Append_Nul => True); + + return Result; end New_String; ---------- diff --git a/gcc/ada/lib-xref.adb b/gcc/ada/lib-xref.adb index 81b724103f4..c0471407a34 100644 --- a/gcc/ada/lib-xref.adb +++ b/gcc/ada/lib-xref.adb @@ -1377,6 +1377,9 @@ package body Lib.Xref is Ctyp : Character; -- Entity type character + Prevt : Character; + -- reference kind of previous reference + Tref : Entity_Id; -- Type reference @@ -1519,6 +1522,7 @@ package body Lib.Xref is Curdef := No_Location; Curru := No_Unit; Crloc := No_Location; + Prevt := 'm'; -- Loop to output references @@ -2193,12 +2197,17 @@ package body Lib.Xref is Crloc := No_Location; end if; - -- Output the reference + -- Output the reference if it is not as the same location + -- as the previous one, or it is a read-reference that + -- indicates that the entity is an in-out actual in a call. if XE.Loc /= No_Location - and then XE.Loc /= Crloc + and then + (XE.Loc /= Crloc + or else (Prevt = 'm' and then XE.Typ = 'r')) then Crloc := XE.Loc; + Prevt := XE.Typ; -- Start continuation if line full, else blank diff --git a/gcc/ada/par-ch3.adb b/gcc/ada/par-ch3.adb index 059b40340ae..4ae03fd213b 100644 --- a/gcc/ada/par-ch3.adb +++ b/gcc/ada/par-ch3.adb @@ -3714,13 +3714,23 @@ package body Ch3 is end if; if Token = Tok_Comma then - Error_Msg_SC -- CODEFIX - (""","" should be ""'|"""); + Scan; -- past comma + + if Token = Tok_Vertical_Bar then + Error_Msg_SP -- CODEFIX + ("|extra "","" ignored"); + Scan; -- past | + + else + Error_Msg_SP -- CODEFIX + (""","" should be ""'|"""); + end if; + else exit when Token /= Tok_Vertical_Bar; + Scan; -- past | end if; - Scan; -- past | or comma end loop; return Choices; diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 5b87a1135cd..9b328fa4f2e 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -1072,12 +1072,13 @@ package body Sem_Ch6 is procedure Analyze_Parameterized_Expression (N : Node_Id) is Loc : constant Source_Ptr := Sloc (N); LocX : constant Source_Ptr := Sloc (Expression (N)); - Def_Id : constant Entity_Id := Defining_Entity (Specification (N)); - Prev : constant Entity_Id := Current_Entity_In_Scope (Def_Id); + Def_Id : constant Entity_Id := Defining_Entity (Specification (N)); + New_Body : Node_Id; + + Prev : constant Entity_Id := Current_Entity_In_Scope (Def_Id); -- If the expression is a completion, Prev is the entity whose -- declaration is completed. - New_Body : Node_Id; begin -- This is one of the occasions on which we transform the tree during -- semantic analysis. Transform the parameterized expression into an @@ -1096,7 +1097,6 @@ package body Sem_Ch6 is if Present (Prev) and then Ekind (Prev) = E_Generic_Function then - -- If the expression completes a generic subprogram, we must create -- a separate node for the body, because at instantiation the -- original node of the generic copy must be a generic subprogram diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index c14c446fe6b..6c78a5b7f54 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -4574,10 +4574,21 @@ package body Sem_Ch8 is -- -- The Is_Actual_Parameter routine takes care of one of these -- cases but there are others probably ??? + -- + -- If the entity is the LHS of an assignment, and is a variable + -- (rather than a package prefix), we can mark it as a + -- modification right away, to avoid duplicate references. else if not Is_Actual_Parameter then - Generate_Reference (E, N); + if Is_LHS (N) + and then Ekind (E) /= E_Package + and then Ekind (E) /= E_Generic_Package + then + Generate_Reference (E, N, 'm'); + else + Generate_Reference (E, N); + end if; end if; Check_Nested_Access (E); @@ -4980,7 +4991,12 @@ package body Sem_Ch8 is Set_Entity (N, Id); else Set_Entity_Or_Discriminal (N, Id); - Generate_Reference (Id, N); + + if Is_LHS (N) then + Generate_Reference (Id, N, 'm'); + else + Generate_Reference (Id, N); + end if; end if; if Is_Type (Id) then diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 47d10b4be92..a5dac143aa8 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -6663,8 +6663,17 @@ package body Sem_Util is 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; + if Nkind (P) = N_Assignment_Statement then + return Name (P) = N; + + elsif + Nkind_In (P, N_Indexed_Component, N_Selected_Component, N_Slice) + then + return N = Prefix (P) and then Is_LHS (P); + + else + return False; + end if; end Is_LHS; ---------------------------- diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index 844e310c806..57129f99b6e 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -7449,6 +7449,13 @@ package Sinfo is -- N_Has_Etype, N_Has_Chars + -- Note: of course N_Error does not really have Etype or Chars fields, + -- and any attempt to access these fields in N_Error will cause an + -- error, but historically this always has been positioned so that an + -- "in N_Has_Chars" or "in N_Has_Etype" test yields true for N_Error. + -- Most likely this makes coding easier somewhere but still seems + -- undesirable. To be investigated some time ??? + N_Error, -- N_Entity, N_Has_Etype, N_Has_Chars -- 2.30.2