[multiple changes]
2010-10-07 Robert Dewar <dewar@adacore.com> * 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 <miranda@adacore.com> * exp_util.adb (Safe_Prefixed_Reference): When removing side effects, Add missing support for explicit dereferences. 2010-10-07 Robert Dewar <dewar@adacore.com> * par-ch10.adb, par-ch3.adb, par.adb: Minor reformatting. From-SVN: r165097
This commit is contained in:
Arnaud Charlet
parent
0bfed5d4cd
commit
2385e00749
|
|
@ -1,3 +1,20 @@
|
|||
2010-10-07 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* 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 <miranda@adacore.com>
|
||||
|
||||
* exp_util.adb (Safe_Prefixed_Reference): When removing side effects,
|
||||
Add missing support for explicit dereferences.
|
||||
|
||||
2010-10-07 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* par-ch10.adb, par-ch3.adb, par.adb: Minor reformatting.
|
||||
|
||||
2010-10-07 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* exp_disp.adb, exp_dist.adb, exp_util.ads, 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:
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
162
gcc/ada/scng.adb
162
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
|
||||
|
|
|
|||
Loading…
Reference in New Issue