1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING3. If not, go to --
19 -- http://www.gnu.org/licenses for a complete copy of the license. --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 ------------------------------------------------------------------------------
26 with Atree
; use Atree
;
27 with Csets
; use Csets
;
28 with Namet
; use Namet
;
30 with Restrict
; use Restrict
;
31 with Rident
; use Rident
;
32 with Scans
; use Scans
;
33 with Sinfo
; use Sinfo
;
34 with Sinput
; use Sinput
;
35 with Uintp
; use Uintp
;
39 Used_As_Identifier
: array (Token_Type
) of Boolean;
40 -- Flags set True if a given keyword is used as an identifier (used to
41 -- make sure that we only post an error message for incorrect use of a
42 -- keyword as an identifier once for a given keyword).
44 ----------------------------
45 -- Determine_Token_Casing --
46 ----------------------------
48 function Determine_Token_Casing
return Casing_Type
is
50 return Scanner
.Determine_Token_Casing
;
51 end Determine_Token_Casing
;
53 ------------------------
54 -- Initialize_Scanner --
55 ------------------------
57 procedure Initialize_Scanner
58 (Unit
: Unit_Number_Type
;
59 Index
: Source_File_Index
) is
61 Scanner
.Initialize_Scanner
(Index
);
62 Set_Unit
(Index
, Unit
);
64 Current_Source_Unit
:= Unit
;
66 -- Set default for Comes_From_Source. All nodes built now until we
67 -- reenter the analyzer will have Comes_From_Source set to True
69 Set_Comes_From_Source_Default
(True);
73 -- Because of the License stuff above, Scng.Initialize_Scanner cannot
74 -- call Scan. Scan initial token (note this initializes Prev_Token,
79 -- Clear flags for reserved words used as identifiers
81 Used_As_Identifier
:= (others => False);
82 end Initialize_Scanner
;
88 procedure Post_Scan
is
89 procedure Check_Obsolescent_Features_Restriction
(S
: Source_Ptr
);
90 -- This checks for Obsolescent_Features restriction being active, and
91 -- if so, flags the restriction as occurring at the given scan location.
93 procedure Check_Obsolete_Base_Char
;
94 -- Check for numeric literal using ':' instead of '#' for based case
96 --------------------------------------------
97 -- Check_Obsolescent_Features_Restriction --
98 --------------------------------------------
100 procedure Check_Obsolescent_Features_Restriction
(S
: Source_Ptr
) is
102 -- Normally we have a node handy for posting restrictions. We don't
103 -- have such a node here, so construct a dummy one with the right
104 -- scan pointer. This is only used to get the Sloc value anyway.
106 Check_Restriction
(No_Obsolescent_Features
, New_Node
(N_Empty
, S
));
107 end Check_Obsolescent_Features_Restriction
;
109 ------------------------------
110 -- Check_Obsolete_Base_Char --
111 ------------------------------
113 procedure Check_Obsolete_Base_Char
is
117 if Based_Literal_Uses_Colon
then
119 -- Find the : for the restriction or warning message
122 while Source
(S
) /= ':' loop
126 Check_Obsolescent_Features_Restriction
(S
);
128 if Warn_On_Obsolescent_Feature
then
130 ("?j?use of "":"" is an obsolescent feature (RM J.2(3))", S
);
132 ("\?j?use ""'#"" instead", S
);
135 end Check_Obsolete_Base_Char
;
137 -- Start of processing for Post_Scan
141 when Tok_Char_Literal
=>
142 Token_Node
:= New_Node
(N_Character_Literal
, Token_Ptr
);
143 Set_Char_Literal_Value
(Token_Node
, UI_From_CC
(Character_Code
));
144 Set_Chars
(Token_Node
, Token_Name
);
146 when Tok_Identifier
=>
147 Token_Node
:= New_Node
(N_Identifier
, Token_Ptr
);
148 Set_Chars
(Token_Node
, Token_Name
);
150 when Tok_Real_Literal
=>
151 Token_Node
:= New_Node
(N_Real_Literal
, Token_Ptr
);
152 Set_Realval
(Token_Node
, Real_Literal_Value
);
153 Check_Obsolete_Base_Char
;
155 when Tok_Integer_Literal
=>
156 Token_Node
:= New_Node
(N_Integer_Literal
, Token_Ptr
);
157 Set_Intval
(Token_Node
, Int_Literal_Value
);
158 Check_Obsolete_Base_Char
;
160 when Tok_String_Literal
=>
161 Token_Node
:= New_Node
(N_String_Literal
, Token_Ptr
);
162 Set_Has_Wide_Character
163 (Token_Node
, Wide_Character_Found
);
164 Set_Has_Wide_Wide_Character
165 (Token_Node
, Wide_Wide_Character_Found
);
166 Set_Strval
(Token_Node
, String_Literal_Id
);
168 if Source
(Token_Ptr
) = '%' then
169 Check_Obsolescent_Features_Restriction
(Token_Ptr
);
171 if Warn_On_Obsolescent_Feature
then
173 ("?j?use of ""'%"" is an obsolescent feature (RM J.2(4))");
174 Error_Msg_SC
("\?j?use """""" instead");
178 when Tok_Operator_Symbol
=>
179 Token_Node
:= New_Node
(N_Operator_Symbol
, Token_Ptr
);
180 Set_Chars
(Token_Node
, Token_Name
);
181 Set_Strval
(Token_Node
, String_Literal_Id
);
183 when Tok_Vertical_Bar
=>
184 if Source
(Token_Ptr
) = '!' then
185 Check_Obsolescent_Features_Restriction
(Token_Ptr
);
187 if Warn_On_Obsolescent_Feature
then
189 ("?j?use of ""'!"" is an obsolescent feature (RM J.2(2))");
190 Error_Msg_SC
("\?j?use ""'|"" instead");
199 ------------------------------
200 -- Scan_Reserved_Identifier --
201 ------------------------------
203 procedure Scan_Reserved_Identifier
(Force_Msg
: Boolean) is
204 Token_Chars
: String := Token_Type
'Image (Token
);
208 -- AI12-0125 : '@' denotes the target_name, i.e. serves as an
209 -- abbreviation for the LHS of an assignment.
211 if Token
= Tok_At_Sign
then
212 Token_Node
:= New_Node
(N_Target_Name
, Token_Ptr
);
216 -- We have in Token_Chars the image of the Token name, i.e. Tok_xxx.
217 -- This code extracts the xxx and makes an identifier out of it.
219 for J
in 5 .. Token_Chars
'Length loop
221 Token_Chars
(Len
) := Fold_Lower
(Token_Chars
(J
));
224 Token_Name
:= Name_Find
(Token_Chars
(1 .. Len
));
226 -- If Inside_Pragma is True, we don't give an error. This is to allow
227 -- things like "pragma Ignore_Pragma (Interface)", where "Interface" is
228 -- a reserved word. There is no danger of missing errors, because any
229 -- misuse must have been preceded by an illegal declaration. For
230 -- example, in "pragma Pack (Begin);", either Begin is not declared,
231 -- which is an error, or it is declared, which will be an error on that
234 if (not Used_As_Identifier
(Token
) or else Force_Msg
)
235 and then not Inside_Pragma
237 Error_Msg_Name_1
:= Token_Name
;
238 Error_Msg_SC
("reserved word* cannot be used as identifier!");
239 Used_As_Identifier
(Token
) := True;
242 Token
:= Tok_Identifier
;
243 Token_Node
:= New_Node
(N_Identifier
, Token_Ptr
);
244 Set_Chars
(Token_Node
, Token_Name
);
245 end Scan_Reserved_Identifier
;