1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2001 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 2, 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 COPYING. If not, write --
19 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
20 -- MA 02111-1307, USA. --
22 -- GNAT was originally developed by the GNAT team at New York University. --
23 -- Extensive contributions were provided by Ada Core Technologies Inc. --
25 ------------------------------------------------------------------------------
27 with Stringt; use Stringt;
32 Delimiter : Character;
33 -- Delimiter (first character of string)
36 -- Current source program character
39 -- Current character code value
42 -- Error flag for Scan_Wide call
44 String_Literal_Id : String_Id;
45 -- Id for currently scanned string value
47 Wide_Character_Found : Boolean := False;
48 -- Set True if wide character found
50 procedure Error_Bad_String_Char;
51 -- Signal bad character in string/character literal. On entry Scan_Ptr
52 -- points to the improper character encountered during the scan. Scan_Ptr
53 -- is not modified, so it still points to the bad character on return.
55 procedure Error_Unterminated_String;
56 -- Procedure called if a line terminator character is encountered during
57 -- scanning a string, meaning that the string is not properly terminated.
60 -- Procedure used to distinguish between string and operator symbol.
61 -- On entry the string has been scanned out, and its characters start
62 -- at Token_Ptr and end one character before Scan_Ptr. On exit Token
63 -- is set to Tok_String_Literal or Tok_Operator_Symbol as appropriate,
64 -- and Token_Node is appropriately initialized. In addition, in the
65 -- operator symbol case, Token_Name is appropriately set.
67 ---------------------------
68 -- Error_Bad_String_Char --
69 ---------------------------
71 procedure Error_Bad_String_Char is
72 C : constant Character := Source (Scan_Ptr);
76 Error_Msg_S ("horizontal tab not allowed in string");
78 elsif C = VT or else C = FF then
79 Error_Msg_S ("format effector not allowed in string");
81 elsif C in Upper_Half_Character then
82 Error_Msg_S ("(Ada 83) upper half character not allowed");
85 Error_Msg_S ("control character not allowed in string");
87 end Error_Bad_String_Char;
89 -------------------------------
90 -- Error_Unterminated_String --
91 -------------------------------
93 procedure Error_Unterminated_String is
95 -- An interesting little refinement. Consider the following examples:
97 -- A := "this is an unterminated string;
98 -- A := "this is an unterminated string &
99 -- P(A, "this is a parameter that didn't get terminated);
101 -- We fiddle a little to do slightly better placement in these cases
102 -- also if there is white space at the end of the line we place the
103 -- flag at the start of this white space, not at the end. Note that
104 -- we only have to test for blanks, since tabs aren't allowed in
105 -- strings in the first place and would have caused an error message.
107 -- Two more cases that we treat specially are:
109 -- A := "this string uses the wrong terminator'
110 -- A := "this string uses the wrong terminator' &
112 -- In these cases we give a different error message as well
114 -- We actually reposition the scan pointer to the point where we
115 -- place the flag in these cases, since it seems a better bet on
116 -- the original intention.
118 while Source (Scan_Ptr - 1) = ' '
119 or else Source (Scan_Ptr - 1) = '&'
121 Scan_Ptr := Scan_Ptr - 1;
125 -- Check for case of incorrect string terminator, but single quote is
126 -- not considered incorrect if the opening terminator misused a single
127 -- quote (error message already given).
130 and then Source (Scan_Ptr - 1) = '''
133 Error_Msg ("incorrect string terminator character", Scan_Ptr - 1);
137 if Source (Scan_Ptr - 1) = ';' then
138 Scan_Ptr := Scan_Ptr - 1;
141 if Source (Scan_Ptr - 1) = ')' then
142 Scan_Ptr := Scan_Ptr - 1;
147 Error_Msg_S ("missing string quote");
148 end Error_Unterminated_String;
154 procedure Set_String is
155 Slen : Int := Int (Scan_Ptr - Token_Ptr - 2);
161 -- Token_Name is currently set to Error_Name. The following section of
162 -- code resets Token_Name to the proper Name_Op_xx value if the string
163 -- is a valid operator symbol, otherwise it is left set to Error_Name.
166 C1 := Source (Token_Ptr + 1);
170 Token_Name := Name_Op_Eq;
173 Token_Name := Name_Op_Gt;
176 Token_Name := Name_Op_Lt;
179 Token_Name := Name_Op_Add;
182 Token_Name := Name_Op_Subtract;
185 Token_Name := Name_Op_Concat;
188 Token_Name := Name_Op_Multiply;
191 Token_Name := Name_Op_Divide;
198 C1 := Source (Token_Ptr + 1);
199 C2 := Source (Token_Ptr + 2);
201 if C1 = '*' and then C2 = '*' then
202 Token_Name := Name_Op_Expon;
207 Token_Name := Name_Op_Ne;
209 Token_Name := Name_Op_Le;
211 Token_Name := Name_Op_Ge;
214 elsif (C1 = 'O' or else C1 = 'o') and then -- OR
215 (C2 = 'R' or else C2 = 'r')
217 Token_Name := Name_Op_Or;
221 C1 := Source (Token_Ptr + 1);
222 C2 := Source (Token_Ptr + 2);
223 C3 := Source (Token_Ptr + 3);
225 if (C1 = 'A' or else C1 = 'a') and then -- AND
226 (C2 = 'N' or else C2 = 'n') and then
227 (C3 = 'D' or else C3 = 'd')
229 Token_Name := Name_Op_And;
231 elsif (C1 = 'A' or else C1 = 'a') and then -- ABS
232 (C2 = 'B' or else C2 = 'b') and then
233 (C3 = 'S' or else C3 = 's')
235 Token_Name := Name_Op_Abs;
237 elsif (C1 = 'M' or else C1 = 'm') and then -- MOD
238 (C2 = 'O' or else C2 = 'o') and then
239 (C3 = 'D' or else C3 = 'd')
241 Token_Name := Name_Op_Mod;
243 elsif (C1 = 'N' or else C1 = 'n') and then -- NOT
244 (C2 = 'O' or else C2 = 'o') and then
245 (C3 = 'T' or else C3 = 't')
247 Token_Name := Name_Op_Not;
249 elsif (C1 = 'R' or else C1 = 'r') and then -- REM
250 (C2 = 'E' or else C2 = 'e') and then
251 (C3 = 'M' or else C3 = 'm')
253 Token_Name := Name_Op_Rem;
255 elsif (C1 = 'X' or else C1 = 'x') and then -- XOR
256 (C2 = 'O' or else C2 = 'o') and then
257 (C3 = 'R' or else C3 = 'r')
259 Token_Name := Name_Op_Xor;
264 -- If it is an operator symbol, then Token_Name is set. If it is some
265 -- other string value, then Token_Name still contains Error_Name.
267 if Token_Name = Error_Name then
268 Token := Tok_String_Literal;
269 Token_Node := New_Node (N_String_Literal, Token_Ptr);
270 Set_Has_Wide_Character (Token_Node, Wide_Character_Found);
273 Token := Tok_Operator_Symbol;
274 Token_Node := New_Node (N_Operator_Symbol, Token_Ptr);
275 Set_Chars (Token_Node, Token_Name);
278 Set_Strval (Token_Node, String_Literal_Id);
287 -- On entry, Scan_Ptr points to the opening character of the string which
288 -- is either a percent, double quote, or apostrophe (single quote). The
289 -- latter case is an error detected by the character literal circuit.
291 Delimiter := Source (Scan_Ptr);
292 Accumulate_Checksum (Delimiter);
294 Scan_Ptr := Scan_Ptr + 1;
296 -- Loop to scan out characters of string literal
299 C := Source (Scan_Ptr);
301 if C = Delimiter then
302 Accumulate_Checksum (C);
303 Scan_Ptr := Scan_Ptr + 1;
304 exit when Source (Scan_Ptr) /= Delimiter;
305 Code := Get_Char_Code (C);
306 Accumulate_Checksum (C);
307 Scan_Ptr := Scan_Ptr + 1;
310 if C = '"' and then Delimiter = '%' then
311 Error_Msg_S ("quote not allowed in percent delimited string");
312 Code := Get_Char_Code (C);
313 Scan_Ptr := Scan_Ptr + 1;
317 Wide_Character_Encoding_Method in WC_ESC_Encoding_Method)
319 (C in Upper_Half_Character
325 Source (Scan_Ptr + 1) = '"'
327 Identifier_Char (Source (Scan_Ptr + 2)))
329 Scan_Wide (Source, Scan_Ptr, Code, Err);
330 Accumulate_Checksum (Code);
333 Error_Illegal_Wide_Character;
334 Code := Get_Char_Code (' ');
338 Accumulate_Checksum (C);
340 if C not in Graphic_Character then
341 if C in Line_Terminator then
342 Error_Unterminated_String;
345 elsif C in Upper_Half_Character then
347 Error_Bad_String_Char;
351 Error_Bad_String_Char;
355 Code := Get_Char_Code (C);
356 Scan_Ptr := Scan_Ptr + 1;
360 Store_String_Char (Code);
362 if not In_Character_Range (Code) then
363 Wide_Character_Found := True;
367 String_Literal_Id := End_String;