]>
Commit | Line | Data |
---|---|---|
996ae0b0 RK |
1 | ------------------------------------------------------------------------------ |
2 | -- -- | |
3 | -- GNAT COMPILER COMPONENTS -- | |
4 | -- -- | |
5 | -- S F N _ S C A N -- | |
6 | -- -- | |
7 | -- B o d y -- | |
8 | -- -- | |
1d005acc | 9 | -- Copyright (C) 2000-2019, Free Software Foundation, Inc. -- |
996ae0b0 RK |
10 | -- -- |
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- -- | |
748086b7 | 13 | -- ware Foundation; either version 3, or (at your option) any later ver- -- |
996ae0b0 RK |
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 -- | |
748086b7 JJ |
16 | -- or FITNESS FOR A PARTICULAR PURPOSE. -- |
17 | -- -- | |
18 | -- As a special exception under Section 7 of GPL version 3, you are granted -- | |
19 | -- additional permissions described in the GCC Runtime Library Exception, -- | |
20 | -- version 3.1, as published by the Free Software Foundation. -- | |
21 | -- -- | |
22 | -- You should have received a copy of the GNU General Public License and -- | |
23 | -- a copy of the GCC Runtime Library Exception along with this program; -- | |
24 | -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- | |
25 | -- <http://www.gnu.org/licenses/>. -- | |
996ae0b0 RK |
26 | -- -- |
27 | -- GNAT was originally developed by the GNAT team at New York University. -- | |
71ff80dc | 28 | -- Extensive contributions were provided by Ada Core Technologies Inc. -- |
996ae0b0 RK |
29 | -- -- |
30 | ------------------------------------------------------------------------------ | |
31 | ||
32 | with Ada.Exceptions; use Ada.Exceptions; | |
33 | ||
34 | package body SFN_Scan is | |
35 | ||
36 | use ASCII; | |
37 | -- Allow easy access to control character definitions | |
38 | ||
fbf5a39b | 39 | EOF : constant Character := ASCII.SUB; |
17bb3f18 RD |
40 | -- The character SUB (16#1A#) is used in DOS-derived systems, such as |
41 | -- Windows to signal the end of a text file. If this character appears as | |
42 | -- the last character of a file scanned by a call to Scan_SFN_Pragmas, then | |
43 | -- it is ignored, otherwise it is treated as an illegal character. | |
fbf5a39b | 44 | |
996ae0b0 RK |
45 | type String_Ptr is access String; |
46 | ||
47 | S : String_Ptr; | |
48 | -- Points to the gnat.adc input file | |
49 | ||
50 | P : Natural; | |
51 | -- Subscript of next character to process in S | |
52 | ||
53 | Line_Num : Natural; | |
54 | -- Current line number | |
55 | ||
56 | Start_Of_Line : Natural; | |
57 | -- Subscript of first character at start of current line | |
58 | ||
59 | ---------------------- | |
60 | -- Local Procedures -- | |
61 | ---------------------- | |
62 | ||
2820d220 AC |
63 | function Acquire_Integer return Natural; |
64 | -- This function skips white space, and then scans and returns | |
65 | -- an unsigned integer. Raises Error if no integer is present | |
66 | -- or if the integer is greater than 999. | |
67 | ||
996ae0b0 RK |
68 | function Acquire_String (B : Natural; E : Natural) return String; |
69 | -- This function takes a string scanned out by Scan_String, strips | |
70 | -- the enclosing quote characters and any internal doubled quote | |
71 | -- characters, and returns the result as a String. The arguments | |
72 | -- B and E are as returned from a call to Scan_String. The lower | |
73 | -- bound of the string returned is always 1. | |
74 | ||
75 | function Acquire_Unit_Name return String; | |
76 | -- Skips white space, and then scans and returns a unit name. The | |
77 | -- unit name is cased exactly as it appears in the source file. | |
78 | -- The terminating character must be white space, or a comma or | |
79 | -- a right parenthesis or end of file. | |
80 | ||
81 | function At_EOF return Boolean; | |
82 | pragma Inline (At_EOF); | |
83 | -- Returns True if at end of file, False if not. Note that this | |
84 | -- function does NOT skip white space, so P is always unchanged. | |
85 | ||
86 | procedure Check_Not_At_EOF; | |
87 | pragma Inline (Check_Not_At_EOF); | |
88 | -- Skips past white space if any, and then raises Error if at | |
89 | -- end of file. Otherwise returns with P skipped past whitespace. | |
90 | ||
91 | function Check_File_Type return Character; | |
92 | -- Skips white space if any, and then looks for any of the tokens | |
93 | -- Spec_File_Name, Body_File_Name, or Subunit_File_Name. If one | |
94 | -- of these is found then the value returned is 's', 'b' or 'u' | |
95 | -- respectively, and P is bumped past the token. If none of | |
96 | -- these tokens is found, then P is unchanged (except for | |
97 | -- possible skip of white space), and a space is returned. | |
98 | ||
99 | function Check_Token (T : String) return Boolean; | |
100 | -- Skips white space if any, and then checks if the string at the | |
101 | -- current location matches the given string T, and the character | |
102 | -- immediately following is non-alphabetic, non-numeric. If so, | |
103 | -- P is stepped past the token, and True is returned. If not, | |
104 | -- P is unchanged (except for possibly skipping past whitespace), | |
211e7410 | 105 | -- and False is returned. T may contain only lower-case letters |
996ae0b0 RK |
106 | -- ('a' .. 'z'). |
107 | ||
108 | procedure Error (Err : String); | |
ae71d81b | 109 | pragma No_Return (Error); |
996ae0b0 RK |
110 | -- Called if an error is detected. Raises Syntax_Error_In_GNAT_ADC |
111 | -- with a message of the form gnat.adc:line:col: xxx, where xxx is | |
112 | -- the string Err passed as a parameter. | |
113 | ||
114 | procedure Require_Token (T : String); | |
115 | -- Skips white space if any, and then requires the given string | |
116 | -- to be present. If it is, the P is stepped past it, otherwise | |
117 | -- Error is raised, since this is a syntax error. Require_Token | |
118 | -- is used only for sequences of special characters, so there | |
119 | -- is no issue of terminators, or casing of letters. | |
120 | ||
121 | procedure Scan_String (B : out Natural; E : out Natural); | |
122 | -- Skips white space if any, then requires that a double quote | |
123 | -- or percent be present (start of string). Raises error if | |
124 | -- neither of these two characters is found. Otherwise scans | |
125 | -- out the string, and returns with P pointing past the | |
126 | -- closing quote and S (B .. E) contains the characters of the | |
127 | -- string (including the enclosing quotes, with internal quotes | |
128 | -- still doubled). Raises Error if the string is malformed. | |
129 | ||
130 | procedure Skip_WS; | |
131 | -- Skips P past any white space characters (end of line | |
132 | -- characters, spaces, comments, horizontal tab characters). | |
133 | ||
2820d220 AC |
134 | --------------------- |
135 | -- Acquire_Integer -- | |
136 | --------------------- | |
137 | ||
138 | function Acquire_Integer return Natural is | |
139 | N : Natural := 0; | |
140 | ||
141 | begin | |
142 | Skip_WS; | |
143 | ||
144 | if S (P) not in '0' .. '9' then | |
145 | Error ("missing index parameter"); | |
146 | end if; | |
147 | ||
148 | while S (P) in '0' .. '9' loop | |
149 | N := N * 10 + Character'Pos (S (P)) - Character'Pos ('0'); | |
150 | ||
151 | if N > 999 then | |
152 | Error ("index value greater than 999"); | |
153 | end if; | |
154 | ||
155 | P := P + 1; | |
156 | end loop; | |
157 | ||
158 | return N; | |
159 | end Acquire_Integer; | |
160 | ||
996ae0b0 RK |
161 | -------------------- |
162 | -- Acquire_String -- | |
163 | -------------------- | |
164 | ||
165 | function Acquire_String (B : Natural; E : Natural) return String is | |
166 | Str : String (1 .. E - B - 1); | |
167 | Q : constant Character := S (B); | |
168 | J : Natural; | |
169 | Ptr : Natural; | |
170 | ||
171 | begin | |
172 | Ptr := B + 1; | |
173 | J := 0; | |
174 | while Ptr < E loop | |
175 | J := J + 1; | |
176 | Str (J) := S (Ptr); | |
177 | ||
178 | if S (Ptr) = Q and then S (Ptr + 1) = Q then | |
179 | Ptr := Ptr + 2; | |
180 | else | |
181 | Ptr := Ptr + 1; | |
182 | end if; | |
183 | end loop; | |
184 | ||
185 | return Str (1 .. J); | |
186 | end Acquire_String; | |
187 | ||
188 | ----------------------- | |
189 | -- Acquire_Unit_Name -- | |
190 | ----------------------- | |
191 | ||
192 | function Acquire_Unit_Name return String is | |
193 | B : Natural; | |
194 | ||
195 | begin | |
196 | Check_Not_At_EOF; | |
197 | B := P; | |
198 | ||
199 | while not At_EOF loop | |
200 | exit when S (P) not in '0' .. '9' | |
201 | and then S (P) /= '.' | |
202 | and then S (P) /= '_' | |
203 | and then not (S (P) = '[' and then S (P + 1) = '"') | |
204 | and then not (S (P) = '"' and then S (P - 1) = '[') | |
205 | and then not (S (P) = '"' and then S (P + 1) = ']') | |
206 | and then not (S (P) = ']' and then S (P - 1) = '"') | |
207 | and then S (P) < 'A'; | |
208 | P := P + 1; | |
209 | end loop; | |
210 | ||
211 | if P = B then | |
212 | Error ("null unit name"); | |
213 | end if; | |
214 | ||
215 | return S (B .. P - 1); | |
216 | end Acquire_Unit_Name; | |
217 | ||
218 | ------------ | |
219 | -- At_EOF -- | |
220 | ------------ | |
221 | ||
222 | function At_EOF return Boolean is | |
223 | begin | |
fbf5a39b AC |
224 | -- Immediate return (False) if before last character of file |
225 | ||
226 | if P < S'Last then | |
227 | return False; | |
228 | ||
229 | -- Special case: DOS EOF character as last character of file is | |
230 | -- allowed and treated as an end of file. | |
231 | ||
232 | elsif P = S'Last then | |
233 | return S (P) = EOF; | |
234 | ||
235 | -- If beyond last character of file, then definitely at EOF | |
236 | ||
237 | else | |
238 | return True; | |
239 | end if; | |
996ae0b0 RK |
240 | end At_EOF; |
241 | ||
242 | --------------------- | |
243 | -- Check_File_Type -- | |
244 | --------------------- | |
245 | ||
246 | function Check_File_Type return Character is | |
247 | begin | |
248 | if Check_Token ("spec_file_name") then | |
249 | return 's'; | |
250 | elsif Check_Token ("body_file_name") then | |
251 | return 'b'; | |
252 | elsif Check_Token ("subunit_file_name") then | |
253 | return 'u'; | |
254 | else | |
255 | return ' '; | |
256 | end if; | |
257 | end Check_File_Type; | |
258 | ||
259 | ---------------------- | |
260 | -- Check_Not_At_EOF -- | |
261 | ---------------------- | |
262 | ||
263 | procedure Check_Not_At_EOF is | |
264 | begin | |
265 | Skip_WS; | |
266 | ||
267 | if At_EOF then | |
268 | Error ("unexpected end of file"); | |
269 | end if; | |
270 | ||
271 | return; | |
272 | end Check_Not_At_EOF; | |
273 | ||
274 | ----------------- | |
275 | -- Check_Token -- | |
276 | ----------------- | |
277 | ||
278 | function Check_Token (T : String) return Boolean is | |
279 | Save_P : Natural; | |
280 | C : Character; | |
281 | ||
282 | begin | |
283 | Skip_WS; | |
284 | Save_P := P; | |
285 | ||
286 | for K in T'Range loop | |
287 | if At_EOF then | |
288 | P := Save_P; | |
289 | return False; | |
290 | end if; | |
291 | ||
292 | C := S (P); | |
293 | ||
294 | if C in 'A' .. 'Z' then | |
295 | C := Character'Val (Character'Pos (C) + | |
296 | (Character'Pos ('a') - Character'Pos ('A'))); | |
297 | end if; | |
298 | ||
299 | if C /= T (K) then | |
300 | P := Save_P; | |
301 | return False; | |
302 | end if; | |
303 | ||
304 | P := P + 1; | |
305 | end loop; | |
306 | ||
307 | if At_EOF then | |
308 | return True; | |
309 | end if; | |
310 | ||
311 | C := S (P); | |
312 | ||
313 | if C in '0' .. '9' | |
314 | or else C in 'a' .. 'z' | |
315 | or else C in 'A' .. 'Z' | |
316 | or else C > Character'Val (127) | |
317 | then | |
318 | P := Save_P; | |
319 | return False; | |
320 | ||
321 | else | |
322 | return True; | |
323 | end if; | |
324 | end Check_Token; | |
325 | ||
326 | ----------- | |
327 | -- Error -- | |
328 | ----------- | |
329 | ||
330 | procedure Error (Err : String) is | |
331 | C : Natural := 0; | |
332 | -- Column number | |
333 | ||
334 | M : String (1 .. 80); | |
335 | -- Buffer used to build resulting error msg | |
336 | ||
337 | LM : Natural := 0; | |
338 | -- Pointer to last set location in M | |
339 | ||
340 | procedure Add_Nat (N : Natural); | |
341 | -- Add chars of integer to error msg buffer | |
342 | ||
2820d220 AC |
343 | ------------- |
344 | -- Add_Nat -- | |
345 | ------------- | |
346 | ||
996ae0b0 RK |
347 | procedure Add_Nat (N : Natural) is |
348 | begin | |
349 | if N > 9 then | |
350 | Add_Nat (N / 10); | |
351 | end if; | |
352 | ||
353 | LM := LM + 1; | |
354 | M (LM) := Character'Val (N mod 10 + Character'Pos ('0')); | |
355 | end Add_Nat; | |
356 | ||
357 | -- Start of processing for Error | |
358 | ||
359 | begin | |
360 | M (1 .. 9) := "gnat.adc:"; | |
361 | LM := 9; | |
362 | Add_Nat (Line_Num); | |
363 | LM := LM + 1; | |
364 | M (LM) := ':'; | |
365 | ||
366 | -- Determine column number | |
367 | ||
368 | for X in Start_Of_Line .. P loop | |
369 | C := C + 1; | |
370 | ||
371 | if S (X) = HT then | |
372 | C := (C + 7) / 8 * 8; | |
373 | end if; | |
374 | end loop; | |
375 | ||
376 | Add_Nat (C); | |
377 | M (LM + 1) := ':'; | |
378 | LM := LM + 1; | |
379 | M (LM + 1) := ' '; | |
380 | LM := LM + 1; | |
381 | ||
382 | M (LM + 1 .. LM + Err'Length) := Err; | |
383 | LM := LM + Err'Length; | |
384 | ||
385 | Raise_Exception (Syntax_Error_In_GNAT_ADC'Identity, M (1 .. LM)); | |
386 | end Error; | |
387 | ||
388 | ------------------- | |
389 | -- Require_Token -- | |
390 | ------------------- | |
391 | ||
392 | procedure Require_Token (T : String) is | |
393 | SaveP : Natural; | |
394 | ||
395 | begin | |
396 | Skip_WS; | |
397 | SaveP := P; | |
398 | ||
399 | for J in T'Range loop | |
400 | ||
401 | if At_EOF or else S (P) /= T (J) then | |
402 | declare | |
403 | S : String (1 .. T'Length + 10); | |
404 | ||
405 | begin | |
406 | S (1 .. 9) := "missing """; | |
407 | S (10 .. T'Length + 9) := T; | |
408 | S (T'Length + 10) := '"'; | |
409 | P := SaveP; | |
410 | Error (S); | |
411 | end; | |
412 | ||
413 | else | |
414 | P := P + 1; | |
415 | end if; | |
416 | end loop; | |
417 | end Require_Token; | |
418 | ||
419 | ---------------------- | |
420 | -- Scan_SFN_Pragmas -- | |
421 | ---------------------- | |
422 | ||
423 | procedure Scan_SFN_Pragmas | |
424 | (Source : String; | |
425 | SFN_Ptr : Set_File_Name_Ptr; | |
426 | SFNP_Ptr : Set_File_Name_Pattern_Ptr) | |
427 | is | |
428 | B, E : Natural; | |
429 | Typ : Character; | |
430 | Cas : Character; | |
431 | ||
432 | begin | |
433 | Line_Num := 1; | |
434 | S := Source'Unrestricted_Access; | |
435 | P := Source'First; | |
436 | Start_Of_Line := P; | |
437 | ||
438 | -- Loop through pragmas in file | |
439 | ||
440 | Main_Scan_Loop : loop | |
441 | Skip_WS; | |
442 | exit Main_Scan_Loop when At_EOF; | |
443 | ||
444 | -- Error if something other than pragma | |
445 | ||
446 | if not Check_Token ("pragma") then | |
447 | Error ("non pragma encountered"); | |
448 | end if; | |
449 | ||
450 | -- Source_File_Name pragma case | |
451 | ||
2820d220 AC |
452 | if Check_Token ("source_file_name") |
453 | or else | |
454 | Check_Token ("source_file_name_project") | |
455 | then | |
996ae0b0 RK |
456 | Require_Token ("("); |
457 | ||
458 | Typ := Check_File_Type; | |
459 | ||
460 | -- First format, with unit name first | |
461 | ||
462 | if Typ = ' ' then | |
463 | if Check_Token ("unit_name") then | |
464 | Require_Token ("=>"); | |
465 | end if; | |
466 | ||
467 | declare | |
468 | U : constant String := Acquire_Unit_Name; | |
469 | ||
470 | begin | |
471 | Require_Token (","); | |
472 | Typ := Check_File_Type; | |
473 | ||
474 | if Typ /= 's' and then Typ /= 'b' then | |
475 | Error ("bad pragma"); | |
476 | end if; | |
477 | ||
478 | Require_Token ("=>"); | |
479 | Scan_String (B, E); | |
480 | ||
481 | declare | |
482 | F : constant String := Acquire_String (B, E); | |
2820d220 | 483 | X : Natural; |
996ae0b0 RK |
484 | |
485 | begin | |
2820d220 AC |
486 | -- Scan Index parameter if present |
487 | ||
488 | if Check_Token (",") then | |
489 | if Check_Token ("index") then | |
490 | Require_Token ("=>"); | |
491 | end if; | |
492 | ||
493 | X := Acquire_Integer; | |
494 | else | |
495 | X := 0; | |
496 | end if; | |
497 | ||
996ae0b0 RK |
498 | Require_Token (")"); |
499 | Require_Token (";"); | |
2820d220 | 500 | SFN_Ptr.all (Typ, U, F, X); |
996ae0b0 RK |
501 | end; |
502 | end; | |
503 | ||
504 | -- Second format with pattern string | |
505 | ||
506 | else | |
507 | Require_Token ("=>"); | |
508 | Scan_String (B, E); | |
509 | ||
510 | declare | |
511 | Pat : constant String := Acquire_String (B, E); | |
512 | Nas : Natural := 0; | |
513 | ||
514 | begin | |
515 | -- Check exactly one asterisk | |
516 | ||
517 | for J in Pat'Range loop | |
518 | if Pat (J) = '*' then | |
519 | Nas := Nas + 1; | |
520 | end if; | |
521 | end loop; | |
522 | ||
523 | if Nas /= 1 then | |
524 | Error ("** not allowed"); | |
525 | end if; | |
526 | ||
527 | B := 0; | |
528 | E := 0; | |
529 | Cas := ' '; | |
530 | ||
531 | -- Loop to scan out Casing or Dot_Replacement parameters | |
532 | ||
533 | loop | |
534 | Check_Not_At_EOF; | |
535 | exit when S (P) = ')'; | |
536 | Require_Token (","); | |
537 | ||
538 | if Check_Token ("casing") then | |
539 | Require_Token ("=>"); | |
540 | ||
541 | if Cas /= ' ' then | |
542 | Error ("duplicate casing argument"); | |
543 | elsif Check_Token ("lowercase") then | |
544 | Cas := 'l'; | |
545 | elsif Check_Token ("uppercase") then | |
546 | Cas := 'u'; | |
547 | elsif Check_Token ("mixedcase") then | |
548 | Cas := 'm'; | |
549 | else | |
550 | Error ("invalid casing argument"); | |
551 | end if; | |
552 | ||
553 | elsif Check_Token ("dot_replacement") then | |
554 | Require_Token ("=>"); | |
555 | ||
556 | if E /= 0 then | |
557 | Error ("duplicate dot_replacement"); | |
558 | else | |
559 | Scan_String (B, E); | |
560 | end if; | |
561 | ||
562 | else | |
563 | Error ("invalid argument"); | |
564 | end if; | |
565 | end loop; | |
566 | ||
567 | Require_Token (")"); | |
568 | Require_Token (";"); | |
569 | ||
570 | if Cas = ' ' then | |
571 | Cas := 'l'; | |
572 | end if; | |
573 | ||
574 | if E = 0 then | |
575 | SFNP_Ptr.all (Pat, Typ, ".", Cas); | |
576 | ||
577 | else | |
578 | declare | |
579 | Dot : constant String := Acquire_String (B, E); | |
580 | ||
581 | begin | |
582 | SFNP_Ptr.all (Pat, Typ, Dot, Cas); | |
583 | end; | |
584 | end if; | |
585 | end; | |
586 | end if; | |
587 | ||
588 | -- Some other pragma, scan to semicolon at end of pragma | |
589 | ||
590 | else | |
591 | Skip_Loop : loop | |
592 | exit Main_Scan_Loop when At_EOF; | |
593 | exit Skip_Loop when S (P) = ';'; | |
594 | ||
595 | if S (P) = '"' or else S (P) = '%' then | |
596 | Scan_String (B, E); | |
597 | else | |
598 | P := P + 1; | |
599 | end if; | |
600 | end loop Skip_Loop; | |
601 | ||
3354f96d | 602 | -- We successfully skipped to semicolon, so skip past it |
996ae0b0 RK |
603 | |
604 | P := P + 1; | |
605 | end if; | |
606 | end loop Main_Scan_Loop; | |
607 | ||
608 | exception | |
609 | when others => | |
f35688c9 | 610 | pragma Assert (P'Valid); |
996ae0b0 RK |
611 | Cursor := P - S'First + 1; |
612 | raise; | |
613 | end Scan_SFN_Pragmas; | |
614 | ||
615 | ----------------- | |
616 | -- Scan_String -- | |
617 | ----------------- | |
618 | ||
619 | procedure Scan_String (B : out Natural; E : out Natural) is | |
620 | Q : Character; | |
621 | ||
622 | begin | |
623 | Check_Not_At_EOF; | |
624 | ||
625 | if S (P) = '"' then | |
626 | Q := '"'; | |
627 | elsif S (P) = '%' then | |
628 | Q := '%'; | |
629 | else | |
630 | Error ("bad string"); | |
631 | Q := '"'; | |
632 | end if; | |
633 | ||
634 | -- Scan out the string, B points to first char | |
635 | ||
636 | B := P; | |
637 | P := P + 1; | |
638 | ||
639 | loop | |
640 | if At_EOF or else S (P) = LF or else S (P) = CR then | |
ed2233dc | 641 | Error -- CODEFIX |
2995ebee | 642 | ("missing string quote"); |
996ae0b0 RK |
643 | |
644 | elsif S (P) = HT then | |
645 | Error ("tab character in string"); | |
646 | ||
647 | elsif S (P) /= Q then | |
648 | P := P + 1; | |
649 | ||
650 | -- We have a quote | |
651 | ||
652 | else | |
653 | P := P + 1; | |
654 | ||
655 | -- Check for doubled quote | |
656 | ||
657 | if not At_EOF and then S (P) = Q then | |
658 | P := P + 1; | |
659 | ||
660 | -- Otherwise this is the terminating quote | |
661 | ||
662 | else | |
663 | E := P - 1; | |
664 | return; | |
665 | end if; | |
666 | end if; | |
667 | end loop; | |
668 | end Scan_String; | |
669 | ||
670 | ------------- | |
671 | -- Skip_WS -- | |
672 | ------------- | |
673 | ||
674 | procedure Skip_WS is | |
675 | begin | |
676 | WS_Scan : while not At_EOF loop | |
677 | case S (P) is | |
678 | ||
679 | -- End of physical line | |
680 | ||
681 | when CR | LF => | |
682 | Line_Num := Line_Num + 1; | |
683 | P := P + 1; | |
684 | ||
685 | while not At_EOF | |
686 | and then (S (P) = CR or else S (P) = LF) | |
687 | loop | |
688 | Line_Num := Line_Num + 1; | |
689 | P := P + 1; | |
690 | end loop; | |
691 | ||
692 | Start_Of_Line := P; | |
693 | ||
694 | -- All other cases of white space characters | |
695 | ||
696 | when ' ' | FF | VT | HT => | |
697 | P := P + 1; | |
698 | ||
699 | -- Comment | |
700 | ||
701 | when '-' => | |
702 | P := P + 1; | |
703 | ||
704 | if At_EOF then | |
705 | Error ("bad comment"); | |
706 | ||
707 | elsif S (P) = '-' then | |
708 | P := P + 1; | |
709 | ||
710 | while not At_EOF loop | |
711 | case S (P) is | |
712 | when CR | LF | FF | VT => | |
713 | exit; | |
714 | when others => | |
715 | P := P + 1; | |
716 | end case; | |
717 | end loop; | |
718 | ||
719 | else | |
720 | P := P - 1; | |
721 | exit WS_Scan; | |
722 | end if; | |
723 | ||
724 | when others => | |
725 | exit WS_Scan; | |
726 | ||
727 | end case; | |
728 | end loop WS_Scan; | |
729 | end Skip_WS; | |
730 | ||
731 | end SFN_Scan; |