From 2385e007496ef4abc4d978a644fbf3cd3f2a0094 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Thu, 7 Oct 2010 14:24:31 +0200 Subject: [PATCH] [multiple changes] 2010-10-07 Robert Dewar * scng.adb (Skip_Other_Format_Characters): New procedure (Start_Of_Wide_Character): New procedure (Scan): Use Start_Of_Wide_Character where appropriate (Scan): Improve error message for other_format chars in identifier (Scan): Allow other_format chars between tokens 2010-10-07 Javier Miranda * exp_util.adb (Safe_Prefixed_Reference): When removing side effects, Add missing support for explicit dereferences. 2010-10-07 Robert Dewar * par-ch10.adb, par-ch3.adb, par.adb: Minor reformatting. From-SVN: r165097 --- gcc/ada/ChangeLog | 17 +++++ gcc/ada/exp_util.adb | 19 +++++ gcc/ada/par-ch10.adb | 1 - gcc/ada/par-ch3.adb | 28 ++++---- gcc/ada/par.adb | 12 ++-- gcc/ada/scng.adb | 162 ++++++++++++++++++++++++++++--------------- 6 files changed, 161 insertions(+), 78 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index a46fb545bb6..2901a1cb14c 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,20 @@ +2010-10-07 Robert Dewar + + * scng.adb (Skip_Other_Format_Characters): New procedure + (Start_Of_Wide_Character): New procedure + (Scan): Use Start_Of_Wide_Character where appropriate + (Scan): Improve error message for other_format chars in identifier + (Scan): Allow other_format chars between tokens + +2010-10-07 Javier Miranda + + * exp_util.adb (Safe_Prefixed_Reference): When removing side effects, + Add missing support for explicit dereferences. + +2010-10-07 Robert Dewar + + * par-ch10.adb, par-ch3.adb, par.adb: Minor reformatting. + 2010-10-07 Robert Dewar * exp_disp.adb, exp_dist.adb, exp_util.ads, exp_util.adb, diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index ae8a8e6e13b..112fe045196 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -4538,6 +4538,25 @@ package body Exp_Util is or else Ekind (Entity (Prefix (N))) = E_In_Parameter; end if; + -- If the prefix is an explicit dereference that is not access-to- + -- constant then this construct is a variable reference, which means + -- it is to be considered to have side effects if Variable_Ref is + -- True. + + -- Exception is an access to an entity that is a constant or an + -- in-parameter. + + elsif Nkind (Prefix (N)) = N_Explicit_Dereference + and then not Is_Access_Constant (Etype (Prefix (Prefix (N)))) + and then Variable_Ref + then + declare + DDT : constant Entity_Id := + Designated_Type (Etype (Prefix (Prefix (N)))); + begin + return Ekind_In (DDT, E_Constant, E_In_Parameter); + end; + -- The following test is the simplest way of solving a complex -- problem uncovered by BB08-010: Side effect on loop bound that -- is a subcomponent of a global variable: diff --git a/gcc/ada/par-ch10.adb b/gcc/ada/par-ch10.adb index e321affbfb9..c7dfee88150 100644 --- a/gcc/ada/par-ch10.adb +++ b/gcc/ada/par-ch10.adb @@ -634,7 +634,6 @@ package body Ch10 is -- Check we did not with any child units Item := First (Context_Items (Comp_Unit_Node)); - while Present (Item) loop if Nkind (Item) = N_With_Clause and then Nkind (Name (Item)) /= N_Identifier diff --git a/gcc/ada/par-ch3.adb b/gcc/ada/par-ch3.adb index ae1ba6643e8..18188ba43b1 100644 --- a/gcc/ada/par-ch3.adb +++ b/gcc/ada/par-ch3.adb @@ -4335,23 +4335,23 @@ package body Ch3 is Done := True; end if; - -- Normally an END terminates the scan for basic declarative - -- items. The one exception is END RECORD, which is probably - -- left over from some other junk. + -- Normally an END terminates the scan for basic declarative items. + -- The one exception is END RECORD, which is probably left over from + -- some other junk. - when Tok_End => - Save_Scan_State (Scan_State); -- at END - Scan; -- past END + when Tok_End => + Save_Scan_State (Scan_State); -- at END + Scan; -- past END - if Token = Tok_Record then - Error_Msg_SP ("no RECORD for this `end record`!"); - Scan; -- past RECORD - TF_Semicolon; + if Token = Tok_Record then + Error_Msg_SP ("no RECORD for this `end record`!"); + Scan; -- past RECORD + TF_Semicolon; - else - Restore_Scan_State (Scan_State); -- to END - Done := True; - end if; + else + Restore_Scan_State (Scan_State); -- to END + Done := True; + end if; -- The following tokens which can only be the start of a statement -- are considered to end a declarative part (i.e. we have a missing diff --git a/gcc/ada/par.adb b/gcc/ada/par.adb index 28c2ca789ee..8a0c9014e2e 100644 --- a/gcc/ada/par.adb +++ b/gcc/ada/par.adb @@ -361,17 +361,17 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is function F return Boolean renames False; Pf_Decl_Gins_Pbod_Rnam_Stub : constant Pf_Rec := - Pf_Rec'(F, T, T, T, T, T, F, F); + Pf_Rec'(F, T, T, T, T, T, F, F); Pf_Decl : constant Pf_Rec := - Pf_Rec'(F, T, F, F, F, F, F, F); + Pf_Rec'(F, T, F, F, F, F, F, F); Pf_Decl_Gins_Pbod_Rnam : constant Pf_Rec := - Pf_Rec'(F, T, T, T, T, F, F, F); + Pf_Rec'(F, T, T, T, T, F, F, F); Pf_Decl_Pbod : constant Pf_Rec := - Pf_Rec'(F, T, F, T, F, F, F, F); + Pf_Rec'(F, T, F, T, F, F, F, F); Pf_Pbod : constant Pf_Rec := - Pf_Rec'(F, F, F, T, F, F, F, F); + Pf_Rec'(F, F, F, T, F, F, F, F); Pf_Spcn : constant Pf_Rec := - Pf_Rec'(T, F, F, F, F, F, F, F); + Pf_Rec'(T, F, F, F, F, F, F, F); -- The above are the only allowed values of Pf_Rec arguments type SS_Rec is record diff --git a/gcc/ada/scng.adb b/gcc/ada/scng.adb index bc34eab49ed..d838445e9c1 100644 --- a/gcc/ada/scng.adb +++ b/gcc/ada/scng.adb @@ -241,6 +241,14 @@ package body Scng is -- past the closing quote of the string literal, Token and Token_Node -- are set appropriately, and the checksum is updated. + procedure Skip_Other_Format_Characters; + -- Skips past any "other format" category characters at the current + -- cursor location (does not skip past spaces or any other characters). + + function Start_Of_Wide_Character return Boolean; + -- Returns True if the scan pointer is pointing to the start of a wide + -- character sequence, does not modify the scan pointer in any case. + ----------------------- -- Check_End_Of_Line -- ----------------------- @@ -1039,15 +1047,7 @@ package body Scng is Code := Get_Char_Code (C); Scan_Ptr := Scan_Ptr + 1; - elsif (C = ESC - and then Wide_Character_Encoding_Method - in WC_ESC_Encoding_Method) - or else (C in Upper_Half_Character - and then Upper_Half_Encoding) - or else (C = '[' - and then Source (Scan_Ptr + 1) = '"' - and then Identifier_Char (Source (Scan_Ptr + 2))) - then + elsif Start_Of_Wide_Character then Wptr := Scan_Ptr; Scan_Wide (Source, Scan_Ptr, Code, Err); @@ -1109,6 +1109,62 @@ package body Scng is return; end Slit; + ---------------------------------- + -- Skip_Other_Format_Characters -- + ---------------------------------- + + procedure Skip_Other_Format_Characters is + P : Source_Ptr; + Code : Char_Code; + Err : Boolean; + + begin + while Start_Of_Wide_Character loop + P := Scan_Ptr; + Scan_Wide (Source, Scan_Ptr, Code, Err); + + if not Is_UTF_32_Other (UTF_32 (Code)) then + Scan_Ptr := P; + return; + end if; + end loop; + end Skip_Other_Format_Characters; + + ----------------------------- + -- Start_Of_Wide_Character -- + ----------------------------- + + function Start_Of_Wide_Character return Boolean is + C : constant Character := Source (Scan_Ptr); + + begin + -- ESC encoding method with ESC present + + if C = ESC + and then Wide_Character_Encoding_Method in WC_ESC_Encoding_Method + then + return True; + + -- Upper half character with upper half encoding + + elsif C in Upper_Half_Character and then Upper_Half_Encoding then + return True; + + -- Brackets encoding + + elsif C = '[' + and then Source (Scan_Ptr + 1) = '"' + and then Identifier_Char (Source (Scan_Ptr + 2)) + then + return True; + + -- Not the start of a wide character + + else + return False; + end if; + end Start_Of_Wide_Character; + -- Start of processing for Scan begin @@ -1513,12 +1569,7 @@ package body Scng is -- If we have a wide character, we have to scan it out, -- because it might be a legitimate line terminator - elsif (Source (Scan_Ptr) = ESC - and then Identifier_Char (ESC)) - or else - (Source (Scan_Ptr) in Upper_Half_Character - and then Upper_Half_Encoding) - then + elsif Start_Of_Wide_Character then declare Wptr : constant Source_Ptr := Scan_Ptr; Code : Char_Code; @@ -1626,18 +1677,7 @@ package body Scng is else -- Case of wide character literal - if (Source (Scan_Ptr) = ESC - and then - Wide_Character_Encoding_Method in WC_ESC_Encoding_Method) - or else - (Source (Scan_Ptr) in Upper_Half_Character - and then - Upper_Half_Encoding) - or else - (Source (Scan_Ptr) = '[' - and then - Source (Scan_Ptr + 1) = '"') - then + if Start_Of_Wide_Character then Wptr := Scan_Ptr; Scan_Wide (Source, Scan_Ptr, Code, Err); Accumulate_Checksum (Code); @@ -1872,6 +1912,10 @@ package body Scng is Nlit; + -- Check for proper delimiter, ignoring other format characters + + Skip_Other_Format_Characters; + if Identifier_Char (Source (Scan_Ptr)) then Error_Msg_S ("delimiter required between literal and identifier"); @@ -2039,6 +2083,12 @@ package body Scng is elsif Is_UTF_32_Space (Cat) then goto Scan_Next_Character; + -- If other format character, ignore and keep scanning (again we + -- do not include in the checksum) (this is for AI-0079). + + elsif Is_UTF_32_Other (Cat) then + goto Scan_Next_Character; + -- If OK wide line terminator, terminate current line elsif Is_UTF_32_Line_Terminator (UTF_32 (Code)) then @@ -2063,16 +2113,6 @@ package body Scng is Underline_Found := False; goto Scan_Identifier; - -- Other format character is an error (at start of identifier) - - elsif Is_UTF_32_Other (Cat) then - Error_Msg - ("identifier cannot start with other format character", Wptr); - Scan_Ptr := Wptr; - Name_Len := 0; - Underline_Found := False; - goto Scan_Identifier; - -- Extended digit character is an error. Could be bad start of -- identifier or bad literal. Not worth doing too much to try to -- distinguish these cases, but we will do a little bit. @@ -2255,6 +2295,33 @@ package body Scng is -- Here if not a normal identifier character else + Cat := Get_Category (UTF_32 (Code)); + + -- Wide character in Unicode category "Other, Format" + -- is not accepted in an identifier. This is because it + -- it is considered a security risk (AI-0091). + + -- However, it is OK for such a character to appear at + -- the end of an identifier. + + if Is_UTF_32_Other (Cat) then + if not Identifier_Char (Source (Scan_Ptr)) then + goto Scan_Identifier_Complete; + else + Error_Msg + ("identifier cannot contain other_format " + & "character", Wptr); + goto Scan_Identifier; + end if; + + -- Wide character in category Separator,Space terminates + + elsif Is_UTF_32_Space (Cat) then + goto Scan_Identifier_Complete; + end if; + + -- Here if wide character is part of the identifier + -- Make sure we are allowing wide characters in -- identifiers. Note that we allow wide character -- notation for an OK identifier character. This in @@ -2267,11 +2334,9 @@ package body Scng is and then Ada_Version < Ada_05 then Error_Msg - ("wide character not allowed in identifier", Wptr); + ("wide character not allowed in identifier", Wptr); end if; - Cat := Get_Category (UTF_32 (Code)); - -- If OK letter, store it folding to upper case. Note -- that we include the folded letter in the checksum. @@ -2311,23 +2376,6 @@ package body Scng is Underline_Found := True; end if; - -- Wide character in Unicode category "Other, Format" - -- is accepted in an identifier, but is ignored and not - -- stored. It seems reasonable to exclude it from the - -- checksum. - - -- Note that it is correct (see AI-395) to simply strip - -- other format characters, before testing for double - -- underlines, or for reserved words). - - elsif Is_UTF_32_Other (Cat) then - null; - - -- Wide character in category Separator,Space terminates - - elsif Is_UTF_32_Space (Cat) then - goto Scan_Identifier_Complete; - -- Any other wide character is not acceptable else -- 2.30.2