1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
10 -- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
12 -- GNAT is free software; you can redistribute it and/or modify it under --
13 -- terms of the GNU General Public License as published by the Free Soft- --
14 -- ware Foundation; either version 2, or (at your option) any later ver- --
15 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
16 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
17 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
18 -- for more details. You should have received a copy of the GNU General --
19 -- Public License distributed with GNAT; see file COPYING. If not, write --
20 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
21 -- MA 02111-1307, USA. --
23 -- GNAT was originally developed by the GNAT team at New York University. --
24 -- Extensive contributions were provided by Ada Core Technologies Inc. --
26 ------------------------------------------------------------------------------
28 with Stringt; use Stringt;
33 Delimiter : Character;
34 -- Delimiter (first character of string)
37 -- Current source program character
40 -- Current character code value
43 -- Error flag for Scan_Wide call
45 String_Literal_Id : String_Id;
46 -- Id for currently scanned string value
48 Wide_Character_Found : Boolean := False;
49 -- Set True if wide character found
51 procedure Error_Bad_String_Char;
52 -- Signal bad character in string/character literal. On entry Scan_Ptr
53 -- points to the improper character encountered during the scan. Scan_Ptr
54 -- is not modified, so it still points to the bad character on return.
56 procedure Error_Unterminated_String;
57 -- Procedure called if a line terminator character is encountered during
58 -- scanning a string, meaning that the string is not properly terminated.
61 -- Procedure used to distinguish between string and operator symbol.
62 -- On entry the string has been scanned out, and its characters start
63 -- at Token_Ptr and end one character before Scan_Ptr. On exit Token
64 -- is set to Tok_String_Literal or Tok_Operator_Symbol as appropriate,
65 -- and Token_Node is appropriately initialized. In addition, in the
66 -- operator symbol case, Token_Name is appropriately set.
68 ---------------------------
69 -- Error_Bad_String_Char --
70 ---------------------------
72 procedure Error_Bad_String_Char is
73 C : constant Character := Source (Scan_Ptr);
77 Error_Msg_S ("horizontal tab not allowed in string");
79 elsif C = VT or else C = FF then
80 Error_Msg_S ("format effector not allowed in string");
82 elsif C in Upper_Half_Character then
83 Error_Msg_S ("(Ada 83) upper half character not allowed");
86 Error_Msg_S ("control character not allowed in string");
88 end Error_Bad_String_Char;
90 -------------------------------
91 -- Error_Unterminated_String --
92 -------------------------------
94 procedure Error_Unterminated_String is
96 -- An interesting little refinement. Consider the following examples:
98 -- A := "this is an unterminated string;
99 -- A := "this is an unterminated string &
100 -- P(A, "this is a parameter that didn't get terminated);
102 -- We fiddle a little to do slightly better placement in these cases
103 -- also if there is white space at the end of the line we place the
104 -- flag at the start of this white space, not at the end. Note that
105 -- we only have to test for blanks, since tabs aren't allowed in
106 -- strings in the first place and would have caused an error message.
108 -- Two more cases that we treat specially are:
110 -- A := "this string uses the wrong terminator'
111 -- A := "this string uses the wrong terminator' &
113 -- In these cases we give a different error message as well
115 -- We actually reposition the scan pointer to the point where we
116 -- place the flag in these cases, since it seems a better bet on
117 -- the original intention.
119 while Source (Scan_Ptr - 1) = ' '
120 or else Source (Scan_Ptr - 1) = '&'
122 Scan_Ptr := Scan_Ptr - 1;
126 -- Check for case of incorrect string terminator, but single quote is
127 -- not considered incorrect if the opening terminator misused a single
128 -- quote (error message already given).
131 and then Source (Scan_Ptr - 1) = '''
134 Error_Msg ("incorrect string terminator character", Scan_Ptr - 1);
138 if Source (Scan_Ptr - 1) = ';' then
139 Scan_Ptr := Scan_Ptr - 1;
142 if Source (Scan_Ptr - 1) = ')' then
143 Scan_Ptr := Scan_Ptr - 1;
148 Error_Msg_S ("missing string quote");
149 end Error_Unterminated_String;
155 procedure Set_String is
156 Slen : Int := Int (Scan_Ptr - Token_Ptr - 2);
162 -- Token_Name is currently set to Error_Name. The following section of
163 -- code resets Token_Name to the proper Name_Op_xx value if the string
164 -- is a valid operator symbol, otherwise it is left set to Error_Name.
167 C1 := Source (Token_Ptr + 1);
171 Token_Name := Name_Op_Eq;
174 Token_Name := Name_Op_Gt;
177 Token_Name := Name_Op_Lt;
180 Token_Name := Name_Op_Add;
183 Token_Name := Name_Op_Subtract;
186 Token_Name := Name_Op_Concat;
189 Token_Name := Name_Op_Multiply;
192 Token_Name := Name_Op_Divide;
199 C1 := Source (Token_Ptr + 1);
200 C2 := Source (Token_Ptr + 2);
202 if C1 = '*' and then C2 = '*' then
203 Token_Name := Name_Op_Expon;
208 Token_Name := Name_Op_Ne;
210 Token_Name := Name_Op_Le;
212 Token_Name := Name_Op_Ge;
215 elsif (C1 = 'O' or else C1 = 'o') and then -- OR
216 (C2 = 'R' or else C2 = 'r')
218 Token_Name := Name_Op_Or;
222 C1 := Source (Token_Ptr + 1);
223 C2 := Source (Token_Ptr + 2);
224 C3 := Source (Token_Ptr + 3);
226 if (C1 = 'A' or else C1 = 'a') and then -- AND
227 (C2 = 'N' or else C2 = 'n') and then
228 (C3 = 'D' or else C3 = 'd')
230 Token_Name := Name_Op_And;
232 elsif (C1 = 'A' or else C1 = 'a') and then -- ABS
233 (C2 = 'B' or else C2 = 'b') and then
234 (C3 = 'S' or else C3 = 's')
236 Token_Name := Name_Op_Abs;
238 elsif (C1 = 'M' or else C1 = 'm') and then -- MOD
239 (C2 = 'O' or else C2 = 'o') and then
240 (C3 = 'D' or else C3 = 'd')
242 Token_Name := Name_Op_Mod;
244 elsif (C1 = 'N' or else C1 = 'n') and then -- NOT
245 (C2 = 'O' or else C2 = 'o') and then
246 (C3 = 'T' or else C3 = 't')
248 Token_Name := Name_Op_Not;
250 elsif (C1 = 'R' or else C1 = 'r') and then -- REM
251 (C2 = 'E' or else C2 = 'e') and then
252 (C3 = 'M' or else C3 = 'm')
254 Token_Name := Name_Op_Rem;
256 elsif (C1 = 'X' or else C1 = 'x') and then -- XOR
257 (C2 = 'O' or else C2 = 'o') and then
258 (C3 = 'R' or else C3 = 'r')
260 Token_Name := Name_Op_Xor;
265 -- If it is an operator symbol, then Token_Name is set. If it is some
266 -- other string value, then Token_Name still contains Error_Name.
268 if Token_Name = Error_Name then
269 Token := Tok_String_Literal;
270 Token_Node := New_Node (N_String_Literal, Token_Ptr);
271 Set_Has_Wide_Character (Token_Node, Wide_Character_Found);
274 Token := Tok_Operator_Symbol;
275 Token_Node := New_Node (N_Operator_Symbol, Token_Ptr);
276 Set_Chars (Token_Node, Token_Name);
279 Set_Strval (Token_Node, String_Literal_Id);
288 -- On entry, Scan_Ptr points to the opening character of the string which
289 -- is either a percent, double quote, or apostrophe (single quote). The
290 -- latter case is an error detected by the character literal circuit.
292 Delimiter := Source (Scan_Ptr);
293 Accumulate_Checksum (Delimiter);
295 Scan_Ptr := Scan_Ptr + 1;
297 -- Loop to scan out characters of string literal
300 C := Source (Scan_Ptr);
302 if C = Delimiter then
303 Accumulate_Checksum (C);
304 Scan_Ptr := Scan_Ptr + 1;
305 exit when Source (Scan_Ptr) /= Delimiter;
306 Code := Get_Char_Code (C);
307 Accumulate_Checksum (C);
308 Scan_Ptr := Scan_Ptr + 1;
311 if C = '"' and then Delimiter = '%' then
312 Error_Msg_S ("quote not allowed in percent delimited string");
313 Code := Get_Char_Code (C);
314 Scan_Ptr := Scan_Ptr + 1;
318 Wide_Character_Encoding_Method in WC_ESC_Encoding_Method)
320 (C in Upper_Half_Character
326 Source (Scan_Ptr + 1) = '"'
328 Identifier_Char (Source (Scan_Ptr + 2)))
330 Scan_Wide (Source, Scan_Ptr, Code, Err);
331 Accumulate_Checksum (Code);
334 Error_Illegal_Wide_Character;
335 Code := Get_Char_Code (' ');
339 Accumulate_Checksum (C);
341 if C not in Graphic_Character then
342 if C in Line_Terminator then
343 Error_Unterminated_String;
346 elsif C in Upper_Half_Character then
348 Error_Bad_String_Char;
352 Error_Bad_String_Char;
356 Code := Get_Char_Code (C);
357 Scan_Ptr := Scan_Ptr + 1;
361 Store_String_Char (Code);
363 if not In_Character_Range (Code) then
364 Wide_Character_Found := True;
368 String_Literal_Id := End_String;