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 Hostparm; use Hostparm;
29 with Namet; use Namet;
31 with Restrict; use Restrict;
32 with Rident; use Rident;
33 with Scans; use Scans;
34 with Sinput; use Sinput;
35 with Snames; use Snames;
36 with Stringt; use Stringt;
37 with Stylesw; use Stylesw;
38 with Uintp; use Uintp;
39 with Urealp; use Urealp;
40 with Widechar; use Widechar;
42 pragma Warnings (Off);
43 -- This package is used also by gnatcoll
45 with System.UTF_32; use System.UTF_32;
46 with System.WCh_Con; use System.WCh_Con;
52 -- Make control characters visible
54 Special_Characters : array (Character) of Boolean := (others => False);
55 -- For characters that are Special token, the value is True
57 Comment_Is_Token : Boolean := False;
58 -- True if comments are tokens
60 End_Of_Line_Is_Token : Boolean := False;
61 -- True if End_Of_Line is a token
63 -----------------------
64 -- Local Subprograms --
65 -----------------------
67 procedure Accumulate_Token_Checksum;
68 pragma Inline (Accumulate_Token_Checksum);
69 -- Called after each numeric literal and identifier/keyword. For keywords,
70 -- the token used is Tok_Identifier. This allows detection of additional
71 -- spaces added in sources when using the builder switch -m.
73 procedure Accumulate_Token_Checksum_GNAT_6_3;
74 -- Used in place of Accumulate_Token_Checksum for GNAT versions 5.04 to
75 -- 6.3, when Tok_Some was not included in Token_Type and the actual
76 -- Token_Type was used for keywords. This procedure is never used in the
77 -- compiler or gnatmake, only in gprbuild.
79 procedure Accumulate_Token_Checksum_GNAT_5_03;
80 -- Used in place of Accumulate_Token_Checksum for GNAT version 5.03, when
81 -- Tok_Interface, Tok_Some, Tok_Synchronized and Tok_Overriding were not
82 -- included in Token_Type and the actual Token_Type was used for keywords.
83 -- This procedure is never used in the compiler or gnatmake, only in
86 procedure Accumulate_Checksum (C : Character);
87 pragma Inline (Accumulate_Checksum);
88 -- This routine accumulates the checksum given character C. During the
89 -- scanning of a source file, this routine is called with every character
90 -- in the source, excluding blanks, and all control characters (except
91 -- that ESC is included in the checksum). Upper case letters not in string
92 -- literals are folded by the caller. See Sinput spec for the documentation
93 -- of the checksum algorithm. Note: checksum values are only used if we
94 -- generate code, so it is not necessary to worry about making the right
95 -- sequence of calls in any error situation.
97 procedure Accumulate_Checksum (C : Char_Code);
98 pragma Inline (Accumulate_Checksum);
99 -- This version is identical, except that the argument, C, is a character
100 -- code value instead of a character. This is used when wide characters
101 -- are scanned. We use the character code rather than the ASCII characters
102 -- so that the checksum is independent of wide character encoding method.
104 procedure Initialize_Checksum;
105 pragma Inline (Initialize_Checksum);
106 -- Initialize checksum value
108 -------------------------
109 -- Accumulate_Checksum --
110 -------------------------
112 procedure Accumulate_Checksum (C : Character) is
114 System.CRC32.Update (System.CRC32.CRC32 (Checksum), C);
115 end Accumulate_Checksum;
117 procedure Accumulate_Checksum (C : Char_Code) is
120 Accumulate_Checksum (Character'Val (C / 2 ** 24));
121 Accumulate_Checksum (Character'Val ((C / 2 ** 16) mod 256));
122 Accumulate_Checksum (Character'Val ((C / 256) mod 256));
124 Accumulate_Checksum (Character'Val (C / 256));
127 Accumulate_Checksum (Character'Val (C mod 256));
128 end Accumulate_Checksum;
130 -------------------------------
131 -- Accumulate_Token_Checksum --
132 -------------------------------
134 procedure Accumulate_Token_Checksum is
137 (System.CRC32.CRC32 (Checksum),
138 Character'Val (Token_Type'Pos (Token)));
139 end Accumulate_Token_Checksum;
141 ----------------------------------------
142 -- Accumulate_Token_Checksum_GNAT_6_3 --
143 ----------------------------------------
145 procedure Accumulate_Token_Checksum_GNAT_6_3 is
147 -- Individual values of Token_Type are used, instead of subranges, so
148 -- that additions or suppressions of enumerated values in type
149 -- Token_Type are detected by the compiler.
175 | Tok_Double_Asterisk
179 | Tok_Greater_Greater
182 | Tok_Integer_Literal
197 | Tok_Operator_Symbol
215 (System.CRC32.CRC32 (Checksum),
216 Character'Val (Token_Type'Pos (Token)));
220 (System.CRC32.CRC32 (Checksum),
221 Character'Val (Token_Type'Pos (Tok_Identifier)));
243 | Tok_External_As_List
281 (System.CRC32.CRC32 (Checksum),
282 Character'Val (Token_Type'Pos (Token_Type'Pred (Token))));
284 end Accumulate_Token_Checksum_GNAT_6_3;
286 -----------------------------------------
287 -- Accumulate_Token_Checksum_GNAT_5_03 --
288 -----------------------------------------
290 procedure Accumulate_Token_Checksum_GNAT_5_03 is
292 -- Individual values of Token_Type are used, instead of subranges, so
293 -- that additions or suppressions of enumerated values in type
294 -- Token_Type are detected by the compiler.
320 | Tok_Double_Asterisk
324 | Tok_Greater_Greater
327 | Tok_Integer_Literal
339 | Tok_Operator_Symbol
353 (System.CRC32.CRC32 (Checksum),
354 Character'Val (Token_Type'Pos (Token)));
362 (System.CRC32.CRC32 (Checksum),
363 Character'Val (Token_Type'Pos (Tok_Identifier)));
373 (System.CRC32.CRC32 (Checksum),
374 Character'Val (Token_Type'Pos (Token) - 1));
410 (System.CRC32.CRC32 (Checksum),
411 Character'Val (Token_Type'Pos (Token) - 2));
421 | Tok_External_As_List
437 (System.CRC32.CRC32 (Checksum),
438 Character'Val (Token_Type'Pos (Token) - 4));
440 end Accumulate_Token_Checksum_GNAT_5_03;
442 -----------------------
443 -- Check_End_Of_Line --
444 -----------------------
446 procedure Check_End_Of_Line is
447 Len : constant Int :=
449 Int (Current_Line_Start) -
450 Wide_Char_Byte_Count;
452 -- Start of processing for Check_End_Of_Line
456 Style.Check_Line_Terminator (Len);
459 -- Deal with checking maximum line length
461 if Style_Check and Style_Check_Max_Line_Length then
462 Style.Check_Line_Max_Length (Len);
464 -- If style checking is inactive, check maximum line length against
467 elsif Len > Max_Line_Length then
469 ("this line is too long",
470 Current_Line_Start + Source_Ptr (Max_Line_Length));
473 -- Now one more checking circuit. Normally we are only enforcing a limit
474 -- of physical characters, with tabs counting as one character. But if
475 -- after tab expansion we would have a total line length that exceeded
476 -- 32766, that would really cause trouble, because column positions
477 -- would exceed the maximum we allow for a column count. Note: the limit
478 -- is 32766 rather than 32767, since we use a value of 32767 for special
479 -- purposes (see Sinput). Now we really do not want to go messing with
480 -- tabs in the normal case, so what we do is to check for a line that
481 -- has more than 4096 physical characters. Any shorter line could not
482 -- be a problem, even if it was all tabs.
491 Ptr := Current_Line_Start;
493 exit when Ptr = Scan_Ptr;
495 if Source (Ptr) = ASCII.HT then
496 Col := (Col - 1 + 8) / 8 * 8 + 1;
503 ("this line is longer than 32766 characters",
505 raise Unrecoverable_Error;
513 -- Reset wide character byte count for next line
515 Wide_Char_Byte_Count := 0;
516 end Check_End_Of_Line;
518 ----------------------------
519 -- Determine_Token_Casing --
520 ----------------------------
522 function Determine_Token_Casing return Casing_Type is
524 return Determine_Casing (Source (Token_Ptr .. Scan_Ptr - 1));
525 end Determine_Token_Casing;
527 -------------------------
528 -- Initialize_Checksum --
529 -------------------------
531 procedure Initialize_Checksum is
533 System.CRC32.Initialize (System.CRC32.CRC32 (Checksum));
534 end Initialize_Checksum;
536 ------------------------
537 -- Initialize_Scanner --
538 ------------------------
540 procedure Initialize_Scanner (Index : Source_File_Index) is
542 -- Establish reserved words
544 Scans.Initialize_Ada_Keywords;
546 -- Initialize scan control variables
548 Current_Source_File := Index;
549 Source := Source_Text (Current_Source_File);
550 Scan_Ptr := Source_First (Current_Source_File);
552 Token_Ptr := Scan_Ptr;
553 Current_Line_Start := Scan_Ptr;
555 Token_Name := No_Name;
556 Start_Column := Set_Start_Column;
557 First_Non_Blank_Location := Scan_Ptr;
560 Wide_Char_Byte_Count := 0;
562 -- Do not call Scan, otherwise the License stuff does not work in Scn
564 end Initialize_Scanner;
566 ------------------------------
567 -- Reset_Special_Characters --
568 ------------------------------
570 procedure Reset_Special_Characters is
572 Special_Characters := (others => False);
573 end Reset_Special_Characters;
581 Start_Of_Comment : Source_Ptr;
582 -- Record start of comment position
584 Underline_Found : Boolean;
585 -- During scanning of an identifier, set to True if last character
586 -- scanned was an underline or other punctuation character. This
587 -- is used to flag the error of two underlines/punctuations in a
588 -- row or ending an identifier with a underline/punctuation. Here
589 -- punctuation means any UTF_32 character in the Unicode category
590 -- Punctuation,Connector.
593 -- Used to remember start of last wide character scanned
595 function Double_Char_Token (C : Character) return Boolean;
596 -- This function is used for double character tokens like := or <>. It
597 -- checks if the character following Source (Scan_Ptr) is C, and if so
598 -- bumps Scan_Ptr past the pair of characters and returns True. A space
599 -- between the two characters is also recognized with an appropriate
600 -- error message being issued. If C is not present, False is returned.
601 -- Note that Double_Char_Token can only be used for tokens defined in
602 -- the Ada syntax (it's use for error cases like && is not appropriate
603 -- since we do not want a junk message for a case like &-space-&).
605 procedure Error_Illegal_Character;
606 -- Give illegal character error, Scan_Ptr points to character. On
607 -- return, Scan_Ptr is bumped past the illegal character.
609 procedure Error_Illegal_Wide_Character;
610 -- Give illegal wide character message. On return, Scan_Ptr is bumped
611 -- past the illegal character, which may still leave us pointing to
612 -- junk, not much we can do if the escape sequence is messed up.
614 procedure Error_No_Double_Underline;
615 -- Signal error of two underline or punctuation characters in a row.
616 -- Called with Scan_Ptr pointing to second underline/punctuation char.
619 -- This is the procedure for scanning out numeric literals. On entry,
620 -- Scan_Ptr points to the digit that starts the numeric literal (the
621 -- checksum for this character has not been accumulated yet). On return
622 -- Scan_Ptr points past the last character of the numeric literal, Token
623 -- and Token_Node are set appropriately, and the checksum is updated.
626 -- This is the procedure for scanning out string literals. On entry,
627 -- Scan_Ptr points to the opening string quote (the checksum for this
628 -- character has not been accumulated yet). On return Scan_Ptr points
629 -- past the closing quote of the string literal, Token and Token_Node
630 -- are set appropriately, and the checksum is updated.
632 procedure Skip_Other_Format_Characters;
633 -- Skips past any "other format" category characters at the current
634 -- cursor location (does not skip past spaces or any other characters).
636 function Start_Of_Wide_Character return Boolean;
637 -- Returns True if the scan pointer is pointing to the start of a wide
638 -- character sequence, does not modify the scan pointer in any case.
640 -----------------------
641 -- Double_Char_Token --
642 -----------------------
644 function Double_Char_Token (C : Character) return Boolean is
646 if Source (Scan_Ptr + 1) = C then
647 Accumulate_Checksum (C);
648 Scan_Ptr := Scan_Ptr + 2;
651 elsif Source (Scan_Ptr + 1) = ' '
652 and then Source (Scan_Ptr + 2) = C
654 Scan_Ptr := Scan_Ptr + 1;
655 Error_Msg_S -- CODEFIX
656 ("no space allowed here");
657 Scan_Ptr := Scan_Ptr + 2;
663 end Double_Char_Token;
665 -----------------------------
666 -- Error_Illegal_Character --
667 -----------------------------
669 procedure Error_Illegal_Character is
671 Error_Msg_S ("illegal character");
672 Scan_Ptr := Scan_Ptr + 1;
673 end Error_Illegal_Character;
675 ----------------------------------
676 -- Error_Illegal_Wide_Character --
677 ----------------------------------
679 procedure Error_Illegal_Wide_Character is
681 Scan_Ptr := Scan_Ptr + 1;
682 Error_Msg ("illegal wide character", Wptr);
683 end Error_Illegal_Wide_Character;
685 -------------------------------
686 -- Error_No_Double_Underline --
687 -------------------------------
689 procedure Error_No_Double_Underline is
691 Underline_Found := False;
693 -- There are four cases, and we special case the messages
695 if Source (Scan_Ptr) = '_' then
696 if Source (Scan_Ptr - 1) = '_' then
697 Error_Msg_S -- CODEFIX
698 ("two consecutive underlines not permitted");
700 Error_Msg_S ("underline cannot follow punctuation character");
704 if Source (Scan_Ptr - 1) = '_' then
705 Error_Msg_S ("punctuation character cannot follow underline");
708 ("two consecutive punctuation characters not permitted");
711 end Error_No_Double_Underline;
720 -- Current source program character
722 Base_Char : Character;
723 -- Either # or : (character at start of based number)
729 -- Value of base in Uint format
732 -- Value of integer scanned by Scan_Integer in Uint format
735 -- Value of integer in numeric value being scanned
738 -- Scale value for real literal
741 -- Scale in Uint format
743 Exponent_Is_Negative : Boolean;
744 -- Set true for negative exponent
746 Extended_Digit_Value : Int;
747 -- Extended digit value
749 Point_Scanned : Boolean;
750 -- Flag for decimal point scanned in numeric literal
752 -----------------------
753 -- Local Subprograms --
754 -----------------------
756 procedure Error_Digit_Expected;
757 -- Signal error of bad digit, Scan_Ptr points to the location at
758 -- which the digit was expected on input, and is unchanged on return.
760 procedure Scan_Integer;
761 -- Scan integer literal. On entry, Scan_Ptr points to a digit, on
762 -- exit Scan_Ptr points past the last character of the integer.
764 -- For each digit encountered, UI_Int_Value is multiplied by 10, and
765 -- the value of the digit added to the result. In addition, the value
766 -- in Scale is decremented by one for each actual digit scanned.
768 --------------------------
769 -- Error_Digit_Expected --
770 --------------------------
772 procedure Error_Digit_Expected is
774 Error_Msg_S ("digit expected");
775 end Error_Digit_Expected;
781 procedure Scan_Integer is
783 -- Next character scanned
786 C := Source (Scan_Ptr);
788 -- Loop through digits (allowing underlines)
791 Accumulate_Checksum (C);
793 UI_Int_Value * 10 + (Character'Pos (C) - Character'Pos ('0'));
794 Scan_Ptr := Scan_Ptr + 1;
796 C := Source (Scan_Ptr);
798 -- Case of underline encountered
802 -- We do not accumulate the '_' in the checksum, so that
803 -- 1_234 is equivalent to 1234, and does not trigger
804 -- compilation for "minimal recompilation" (gnatmake -m).
807 Scan_Ptr := Scan_Ptr + 1;
808 C := Source (Scan_Ptr);
810 Error_No_Double_Underline;
813 if C not in '0' .. '9' then
814 Error_Digit_Expected;
819 exit when C not in '0' .. '9';
824 -- Start of processing for Nlit
829 UI_Int_Value := Uint_0;
830 Based_Literal_Uses_Colon := False;
833 Point_Scanned := False;
834 UI_Num_Value := UI_Int_Value;
836 -- Various possibilities now for continuing the literal are period,
837 -- E/e (for exponent), or :/# (for based literal).
840 C := Source (Scan_Ptr);
844 -- Scan out point, but do not scan past .. which is a range
845 -- sequence, and must not be eaten up scanning a numeric literal.
847 while C = '.' and then Source (Scan_Ptr + 1) /= '.' loop
848 Accumulate_Checksum ('.');
850 if Point_Scanned then
851 Error_Msg_S ("duplicate point ignored");
854 Point_Scanned := True;
855 Scan_Ptr := Scan_Ptr + 1;
856 C := Source (Scan_Ptr);
858 if C not in '0' .. '9' then
860 ("real literal cannot end with point", Scan_Ptr - 1);
863 UI_Num_Value := UI_Int_Value;
867 -- Based literal case. The base is the value we already scanned.
868 -- In the case of colon, we insist that the following character
869 -- is indeed an extended digit or a period. This catches a number
870 -- of common errors, as well as catching the well known tricky
871 -- bug otherwise arising from "x : integer range 1 .. 10:= 6;"
874 or else (C = ':' and then
875 (Source (Scan_Ptr + 1) = '.'
877 Source (Scan_Ptr + 1) in '0' .. '9'
879 Source (Scan_Ptr + 1) in 'A' .. 'Z'
881 Source (Scan_Ptr + 1) in 'a' .. 'z'))
883 Accumulate_Checksum (C);
885 UI_Base := UI_Int_Value;
887 if Base_Char = ':' then
888 Based_Literal_Uses_Colon := True;
891 if UI_Base < 2 or else UI_Base > 16 then
892 Error_Msg_SC ("base not 2-16");
896 Base := UI_To_Int (UI_Base);
897 Scan_Ptr := Scan_Ptr + 1;
899 -- Scan out extended integer [. integer]
901 C := Source (Scan_Ptr);
902 UI_Int_Value := Uint_0;
906 if C in '0' .. '9' then
907 Accumulate_Checksum (C);
908 Extended_Digit_Value :=
909 Int'(Character'Pos (C)) - Int'(Character'Pos ('0'));
911 elsif C in 'A' .. 'F' then
912 Accumulate_Checksum (Character'Val (Character'Pos (C) + 32));
913 Extended_Digit_Value :=
914 Int'(Character'Pos (C)) - Int'(Character'Pos ('A')) + 10;
916 elsif C in 'a' .. 'f' then
917 Accumulate_Checksum (C);
918 Extended_Digit_Value :=
919 Int'(Character'Pos (C)) - Int'(Character'Pos ('a')) + 10;
922 Error_Msg_S ("extended digit expected");
926 if Extended_Digit_Value >= Base then
927 Error_Msg_S ("digit '>= base");
930 UI_Int_Value := UI_Int_Value * UI_Base + Extended_Digit_Value;
932 Scan_Ptr := Scan_Ptr + 1;
933 C := Source (Scan_Ptr);
937 Accumulate_Checksum ('_');
938 Scan_Ptr := Scan_Ptr + 1;
939 C := Source (Scan_Ptr);
941 Error_No_Double_Underline;
945 Accumulate_Checksum ('.');
947 if Point_Scanned then
948 Error_Msg_S ("duplicate point ignored");
951 Scan_Ptr := Scan_Ptr + 1;
952 C := Source (Scan_Ptr);
953 Point_Scanned := True;
956 elsif C = Base_Char then
957 Accumulate_Checksum (C);
958 Scan_Ptr := Scan_Ptr + 1;
961 elsif C = '#' or else C = ':' then
962 Error_Msg_S ("based number delimiters must match");
963 Scan_Ptr := Scan_Ptr + 1;
966 elsif not Identifier_Char (C) then
967 if Base_Char = '#' then
968 Error_Msg_S -- CODEFIX
971 Error_Msg_S -- CODEFIX
980 UI_Num_Value := UI_Int_Value;
985 if not Point_Scanned then
989 UI_Scale := UI_From_Int (Scale);
992 if Source (Scan_Ptr) = 'e' or else Source (Scan_Ptr) = 'E' then
993 Accumulate_Checksum ('e');
994 Scan_Ptr := Scan_Ptr + 1;
995 Exponent_Is_Negative := False;
997 if Source (Scan_Ptr) = '+' then
998 Accumulate_Checksum ('+');
999 Scan_Ptr := Scan_Ptr + 1;
1001 elsif Source (Scan_Ptr) = '-' then
1002 Accumulate_Checksum ('-');
1004 if not Point_Scanned then
1006 ("negative exponent not allowed for integer literal");
1008 Exponent_Is_Negative := True;
1011 Scan_Ptr := Scan_Ptr + 1;
1014 UI_Int_Value := Uint_0;
1016 if Source (Scan_Ptr) in '0' .. '9' then
1019 Error_Digit_Expected;
1022 if Exponent_Is_Negative then
1023 UI_Scale := UI_Scale - UI_Int_Value;
1025 UI_Scale := UI_Scale + UI_Int_Value;
1029 -- Case of real literal to be returned
1031 if Point_Scanned then
1032 Token := Tok_Real_Literal;
1033 Real_Literal_Value :=
1034 UR_From_Components (
1035 Num => UI_Num_Value,
1039 -- Case of integer literal to be returned
1042 Token := Tok_Integer_Literal;
1044 if UI_Scale = 0 then
1045 Int_Literal_Value := UI_Num_Value;
1047 -- Avoid doing possibly expensive calculations in cases like
1048 -- parsing 163E800_000# when semantics will not be done anyway.
1049 -- This is especially useful when parsing garbled input.
1051 elsif Operating_Mode /= Check_Syntax
1052 and then (Serious_Errors_Detected = 0 or else Try_Semantics)
1054 Int_Literal_Value := UI_Num_Value * UI_Base ** UI_Scale;
1057 Int_Literal_Value := No_Uint;
1061 if Checksum_Accumulate_Token_Checksum then
1062 Accumulate_Token_Checksum;
1074 Delimiter : Character;
1075 -- Delimiter (first character of string)
1078 -- Current source program character
1081 -- Current character code value
1084 -- Error flag for Scan_Wide call
1086 String_Start : Source_Ptr;
1087 -- Point to first character of string
1089 procedure Error_Bad_String_Char;
1090 -- Signal bad character in string/character literal. On entry
1091 -- Scan_Ptr points to the improper character encountered during the
1092 -- scan. Scan_Ptr is not modified, so it still points to the bad
1093 -- character on return.
1095 procedure Error_Unterminated_String;
1096 -- Procedure called if a line terminator character is encountered
1097 -- during scanning a string, meaning that the string is not properly
1100 procedure Set_String;
1101 -- Procedure used to distinguish between string and operator symbol.
1102 -- On entry the string has been scanned out, and its characters start
1103 -- at Token_Ptr and end one character before Scan_Ptr. On exit Token
1104 -- is set to Tok_String_Literal/Tok_Operator_Symbol as appropriate,
1105 -- and Token_Node is appropriately initialized. In addition, in the
1106 -- operator symbol case, Token_Name is appropriately set, and the
1107 -- flags [Wide_]Wide_Character_Found are set appropriately.
1109 ---------------------------
1110 -- Error_Bad_String_Char --
1111 ---------------------------
1113 procedure Error_Bad_String_Char is
1114 C : constant Character := Source (Scan_Ptr);
1118 Error_Msg_S ("horizontal tab not allowed in string");
1120 elsif C = VT or else C = FF then
1121 Error_Msg_S ("format effector not allowed in string");
1123 elsif C in Upper_Half_Character then
1124 Error_Msg_S ("(Ada 83) upper half character not allowed");
1127 Error_Msg_S ("control character not allowed in string");
1129 end Error_Bad_String_Char;
1131 -------------------------------
1132 -- Error_Unterminated_String --
1133 -------------------------------
1135 procedure Error_Unterminated_String is
1139 -- An interesting little refinement. Consider the following
1142 -- A := "this is an unterminated string;
1143 -- A := "this is an unterminated string &
1144 -- P(A, "this is a parameter that didn't get terminated);
1145 -- P("this is a parameter that didn't get terminated, A);
1147 -- We fiddle a little to do slightly better placement in these
1148 -- cases also if there is white space at the end of the line we
1149 -- place the flag at the start of this white space, not at the
1150 -- end. Note that we only have to test for blanks, since tabs
1151 -- aren't allowed in strings in the first place and would have
1152 -- caused an error message.
1154 -- Two more cases that we treat specially are:
1156 -- A := "this string uses the wrong terminator'
1157 -- A := "this string uses the wrong terminator' &
1159 -- In these cases we give a different error message as well
1161 -- We actually reposition the scan pointer to the point where we
1162 -- place the flag in these cases, since it seems a better bet on
1163 -- the original intention.
1165 while Source (Scan_Ptr - 1) = ' '
1166 or else Source (Scan_Ptr - 1) = '&'
1168 Scan_Ptr := Scan_Ptr - 1;
1169 Unstore_String_Char;
1172 -- Check for case of incorrect string terminator, but single quote
1173 -- is not considered incorrect if the opening terminator misused
1174 -- a single quote (error message already given).
1177 and then Source (Scan_Ptr - 1) = '''
1179 Unstore_String_Char;
1181 ("incorrect string terminator character", Scan_Ptr - 1);
1185 -- Backup over semicolon or right-paren/semicolon sequence
1187 if Source (Scan_Ptr - 1) = ';' then
1188 Scan_Ptr := Scan_Ptr - 1;
1189 Unstore_String_Char;
1191 if Source (Scan_Ptr - 1) = ')' then
1192 Scan_Ptr := Scan_Ptr - 1;
1193 Unstore_String_Char;
1197 -- See if there is a comma in the string, if so, guess that
1198 -- the first comma terminates the string.
1201 while S < Scan_Ptr loop
1202 if Source (S) = ',' then
1203 while Scan_Ptr > S loop
1204 Scan_Ptr := Scan_Ptr - 1;
1205 Unstore_String_Char;
1214 -- Now we have adjusted the scan pointer, give message
1216 Error_Msg_S -- CODEFIX
1217 ("missing string quote");
1218 end Error_Unterminated_String;
1224 procedure Set_String is
1225 Slen : constant Int := Int (Scan_Ptr - Token_Ptr - 2);
1231 -- Token_Name is currently set to Error_Name. The following
1232 -- section of code resets Token_Name to the proper Name_Op_xx
1233 -- value if the string is a valid operator symbol, otherwise it is
1234 -- left set to Error_Name.
1237 C1 := Source (Token_Ptr + 1);
1241 Token_Name := Name_Op_Eq;
1244 Token_Name := Name_Op_Gt;
1247 Token_Name := Name_Op_Lt;
1250 Token_Name := Name_Op_Add;
1253 Token_Name := Name_Op_Subtract;
1256 Token_Name := Name_Op_Concat;
1259 Token_Name := Name_Op_Multiply;
1262 Token_Name := Name_Op_Divide;
1269 C1 := Source (Token_Ptr + 1);
1270 C2 := Source (Token_Ptr + 2);
1272 if C1 = '*' and then C2 = '*' then
1273 Token_Name := Name_Op_Expon;
1278 Token_Name := Name_Op_Ne;
1280 Token_Name := Name_Op_Le;
1282 Token_Name := Name_Op_Ge;
1285 elsif (C1 = 'O' or else C1 = 'o') and then -- OR
1286 (C2 = 'R' or else C2 = 'r')
1288 Token_Name := Name_Op_Or;
1292 C1 := Source (Token_Ptr + 1);
1293 C2 := Source (Token_Ptr + 2);
1294 C3 := Source (Token_Ptr + 3);
1296 if (C1 = 'A' or else C1 = 'a') and then -- AND
1297 (C2 = 'N' or else C2 = 'n') and then
1298 (C3 = 'D' or else C3 = 'd')
1300 Token_Name := Name_Op_And;
1302 elsif (C1 = 'A' or else C1 = 'a') and then -- ABS
1303 (C2 = 'B' or else C2 = 'b') and then
1304 (C3 = 'S' or else C3 = 's')
1306 Token_Name := Name_Op_Abs;
1308 elsif (C1 = 'M' or else C1 = 'm') and then -- MOD
1309 (C2 = 'O' or else C2 = 'o') and then
1310 (C3 = 'D' or else C3 = 'd')
1312 Token_Name := Name_Op_Mod;
1314 elsif (C1 = 'N' or else C1 = 'n') and then -- NOT
1315 (C2 = 'O' or else C2 = 'o') and then
1316 (C3 = 'T' or else C3 = 't')
1318 Token_Name := Name_Op_Not;
1320 elsif (C1 = 'R' or else C1 = 'r') and then -- REM
1321 (C2 = 'E' or else C2 = 'e') and then
1322 (C3 = 'M' or else C3 = 'm')
1324 Token_Name := Name_Op_Rem;
1326 elsif (C1 = 'X' or else C1 = 'x') and then -- XOR
1327 (C2 = 'O' or else C2 = 'o') and then
1328 (C3 = 'R' or else C3 = 'r')
1330 Token_Name := Name_Op_Xor;
1335 -- If it is an operator symbol, then Token_Name is set. If it is
1336 -- some other string value, then Token_Name still contains
1339 if Token_Name = Error_Name then
1340 Token := Tok_String_Literal;
1343 Token := Tok_Operator_Symbol;
1347 -- Start of processing for Slit
1350 -- On entry, Scan_Ptr points to the opening character of the string
1351 -- which is either a percent, double quote, or apostrophe (single
1352 -- quote). The latter case is an error detected by the character
1355 String_Start := Scan_Ptr;
1357 Delimiter := Source (Scan_Ptr);
1358 Accumulate_Checksum (Delimiter);
1361 Wide_Character_Found := False;
1362 Wide_Wide_Character_Found := False;
1363 Scan_Ptr := Scan_Ptr + 1;
1365 -- Loop to scan out characters of string literal
1368 C := Source (Scan_Ptr);
1370 if C = Delimiter then
1371 Accumulate_Checksum (C);
1372 Scan_Ptr := Scan_Ptr + 1;
1373 exit when Source (Scan_Ptr) /= Delimiter;
1374 Code := Get_Char_Code (C);
1375 Accumulate_Checksum (C);
1376 Scan_Ptr := Scan_Ptr + 1;
1379 if C = '"' and then Delimiter = '%' then
1381 ("quote not allowed in percent delimited string");
1382 Code := Get_Char_Code (C);
1383 Scan_Ptr := Scan_Ptr + 1;
1385 elsif Start_Of_Wide_Character then
1387 Scan_Wide (Source, Scan_Ptr, Code, Err);
1390 Error_Illegal_Wide_Character;
1391 Code := Get_Char_Code (' ');
1394 Accumulate_Checksum (Code);
1396 -- In Ada 95 mode we allow any wide characters in a string
1397 -- but in Ada 2005, the set of characters allowed has been
1398 -- restricted to graphic characters.
1400 if Ada_Version >= Ada_2005
1401 and then Is_UTF_32_Non_Graphic (UTF_32 (Code))
1404 ("(Ada 2005) non-graphic character not permitted " &
1405 "in string literal", Wptr);
1409 Accumulate_Checksum (C);
1411 if C not in Graphic_Character then
1412 if C in Line_Terminator then
1413 Error_Unterminated_String;
1416 elsif C in Upper_Half_Character then
1417 if Ada_Version = Ada_83 then
1418 Error_Bad_String_Char;
1422 Error_Bad_String_Char;
1426 Code := Get_Char_Code (C);
1427 Scan_Ptr := Scan_Ptr + 1;
1431 Store_String_Char (Code);
1433 if not In_Character_Range (Code) then
1434 if In_Wide_Character_Range (Code) then
1435 Wide_Character_Found := True;
1437 Wide_Wide_Character_Found := True;
1442 String_Literal_Id := End_String;
1447 ----------------------------------
1448 -- Skip_Other_Format_Characters --
1449 ----------------------------------
1451 procedure Skip_Other_Format_Characters is
1457 while Start_Of_Wide_Character loop
1459 Scan_Wide (Source, Scan_Ptr, Code, Err);
1461 if not Is_UTF_32_Other (UTF_32 (Code)) then
1466 end Skip_Other_Format_Characters;
1468 -----------------------------
1469 -- Start_Of_Wide_Character --
1470 -----------------------------
1472 function Start_Of_Wide_Character return Boolean is
1473 C : constant Character := Source (Scan_Ptr);
1476 -- ESC encoding method with ESC present
1479 and then Wide_Character_Encoding_Method in WC_ESC_Encoding_Method
1483 -- Upper half character with upper half encoding
1485 elsif C in Upper_Half_Character and then Upper_Half_Encoding then
1488 -- Brackets encoding
1491 and then Source (Scan_Ptr + 1) = '"'
1492 and then Identifier_Char (Source (Scan_Ptr + 2))
1496 -- Not the start of a wide character
1501 end Start_Of_Wide_Character;
1503 -- Start of processing for Scan
1506 Prev_Token := Token;
1507 Prev_Token_Ptr := Token_Ptr;
1508 Token_Name := Error_Name;
1510 -- The following loop runs more than once only if a format effector
1511 -- (tab, vertical tab, form feed, line feed, carriage return) is
1512 -- encountered and skipped, or some error situation, such as an
1513 -- illegal character, is encountered.
1515 <<Scan_Next_Character>>
1518 -- Skip past blanks, loop is opened up for speed
1520 while Source (Scan_Ptr) = ' ' loop
1521 if Source (Scan_Ptr + 1) /= ' ' then
1522 Scan_Ptr := Scan_Ptr + 1;
1526 if Source (Scan_Ptr + 2) /= ' ' then
1527 Scan_Ptr := Scan_Ptr + 2;
1531 if Source (Scan_Ptr + 3) /= ' ' then
1532 Scan_Ptr := Scan_Ptr + 3;
1536 if Source (Scan_Ptr + 4) /= ' ' then
1537 Scan_Ptr := Scan_Ptr + 4;
1541 if Source (Scan_Ptr + 5) /= ' ' then
1542 Scan_Ptr := Scan_Ptr + 5;
1546 if Source (Scan_Ptr + 6) /= ' ' then
1547 Scan_Ptr := Scan_Ptr + 6;
1551 if Source (Scan_Ptr + 7) /= ' ' then
1552 Scan_Ptr := Scan_Ptr + 7;
1556 Scan_Ptr := Scan_Ptr + 8;
1559 -- We are now at a non-blank character, which is the first character
1560 -- of the token we will scan, and hence the value of Token_Ptr.
1562 Token_Ptr := Scan_Ptr;
1564 -- Here begins the main case statement which transfers control on the
1565 -- basis of the non-blank character we have encountered.
1567 case Source (Scan_Ptr) is
1569 -- Line terminator characters
1571 when CR | LF | FF | VT =>
1572 goto Scan_Line_Terminator;
1574 -- Horizontal tab, just skip past it
1581 Scan_Ptr := Scan_Ptr + 1;
1583 -- End of file character, treated as an end of file only if it is
1584 -- the last character in the buffer, otherwise it is ignored.
1587 if Scan_Ptr = Source_Last (Current_Source_File) then
1597 Scan_Ptr := Scan_Ptr + 1;
1603 Accumulate_Checksum ('&');
1605 if Source (Scan_Ptr + 1) = '&' then
1606 Error_Msg_S -- CODEFIX
1607 ("'&'& should be `AND THEN`");
1608 Scan_Ptr := Scan_Ptr + 2;
1613 Scan_Ptr := Scan_Ptr + 1;
1614 Token := Tok_Ampersand;
1619 if Ada_Version < Ada_2020 then
1620 Error_Msg ("target_name is an Ada 2020 feature", Scan_Ptr);
1621 Scan_Ptr := Scan_Ptr + 1;
1624 -- AI12-0125-03 : @ is target_name
1626 Accumulate_Checksum ('@');
1627 Scan_Ptr := Scan_Ptr + 1;
1628 Token := Tok_At_Sign;
1632 -- Asterisk (can be multiplication operator or double asterisk which
1633 -- is the exponentiation compound delimiter).
1636 Accumulate_Checksum ('*');
1638 if Source (Scan_Ptr + 1) = '*' then
1639 Accumulate_Checksum ('*');
1640 Scan_Ptr := Scan_Ptr + 2;
1641 Token := Tok_Double_Asterisk;
1645 Scan_Ptr := Scan_Ptr + 1;
1646 Token := Tok_Asterisk;
1650 -- Colon, which can either be an isolated colon, or part of an
1651 -- assignment compound delimiter.
1654 Accumulate_Checksum (':');
1656 if Double_Char_Token ('=') then
1657 Token := Tok_Colon_Equal;
1660 Style.Check_Colon_Equal;
1665 elsif Source (Scan_Ptr + 1) = '-'
1666 and then Source (Scan_Ptr + 2) /= '-'
1668 Token := Tok_Colon_Equal;
1669 Error_Msg -- CODEFIX
1670 (":- should be :=", Scan_Ptr);
1671 Scan_Ptr := Scan_Ptr + 2;
1675 Scan_Ptr := Scan_Ptr + 1;
1688 Accumulate_Checksum ('(');
1689 Scan_Ptr := Scan_Ptr + 1;
1690 Token := Tok_Left_Paren;
1693 Style.Check_Left_Paren;
1701 if Source (Scan_Ptr + 1) = '"' then
1702 goto Scan_Wide_Character;
1704 elsif Ada_Version = Ada_2020 then
1705 Scan_Ptr := Scan_Ptr + 1;
1706 Token := Tok_Left_Bracket;
1710 Error_Msg_S ("illegal character, replaced by ""(""");
1711 Scan_Ptr := Scan_Ptr + 1;
1712 Token := Tok_Left_Paren;
1719 Error_Msg_S ("illegal character, replaced by ""(""");
1720 Scan_Ptr := Scan_Ptr + 1;
1721 Token := Tok_Left_Paren;
1727 Accumulate_Checksum (',');
1728 Scan_Ptr := Scan_Ptr + 1;
1737 -- Dot, which is either an isolated period, or part of a double dot
1738 -- compound delimiter sequence. We also check for the case of a
1739 -- digit following the period, to give a better error message.
1742 Accumulate_Checksum ('.');
1744 if Double_Char_Token ('.') then
1745 Token := Tok_Dot_Dot;
1748 Style.Check_Dot_Dot;
1753 elsif Source (Scan_Ptr + 1) in '0' .. '9' then
1754 Error_Msg_S ("numeric literal cannot start with point");
1755 Scan_Ptr := Scan_Ptr + 1;
1758 Scan_Ptr := Scan_Ptr + 1;
1763 -- Equal, which can either be an equality operator, or part of the
1764 -- arrow (=>) compound delimiter.
1767 Accumulate_Checksum ('=');
1769 if Double_Char_Token ('>') then
1773 Style.Check_Arrow (Inside_Depends);
1778 elsif Source (Scan_Ptr + 1) = '=' then
1779 Error_Msg_S -- CODEFIX
1781 Scan_Ptr := Scan_Ptr + 1;
1784 Scan_Ptr := Scan_Ptr + 1;
1788 -- Greater than, which can be a greater than operator, greater than
1789 -- or equal operator, or first character of a right label bracket.
1792 Accumulate_Checksum ('>');
1794 if Double_Char_Token ('=') then
1795 Token := Tok_Greater_Equal;
1798 elsif Double_Char_Token ('>') then
1799 Token := Tok_Greater_Greater;
1803 Scan_Ptr := Scan_Ptr + 1;
1804 Token := Tok_Greater;
1808 -- Less than, which can be a less than operator, less than or equal
1809 -- operator, or the first character of a left label bracket, or the
1810 -- first character of a box (<>) compound delimiter.
1813 Accumulate_Checksum ('<');
1815 if Double_Char_Token ('=') then
1816 Token := Tok_Less_Equal;
1819 elsif Double_Char_Token ('>') then
1828 elsif Double_Char_Token ('<') then
1829 Token := Tok_Less_Less;
1833 Scan_Ptr := Scan_Ptr + 1;
1838 -- Minus, which is either a subtraction operator, or the first
1839 -- character of double minus starting a comment
1841 when '-' => Minus_Case : begin
1842 if Source (Scan_Ptr + 1) = '>' then
1843 Error_Msg_S ("invalid token");
1844 Scan_Ptr := Scan_Ptr + 2;
1848 elsif Source (Scan_Ptr + 1) /= '-' then
1849 Accumulate_Checksum ('-');
1850 Scan_Ptr := Scan_Ptr + 1;
1856 else -- Source (Scan_Ptr + 1) = '-' then
1858 Style.Check_Comment;
1861 Scan_Ptr := Scan_Ptr + 2;
1863 -- If we are in preprocessor mode with Replace_In_Comments set,
1864 -- then we return the "--" as a token on its own.
1866 if Replace_In_Comments then
1867 Token := Tok_Comment;
1871 -- Otherwise scan out the comment
1873 Start_Of_Comment := Scan_Ptr;
1875 -- Loop to scan comment (this loop runs more than once only if
1876 -- a horizontal tab or other non-graphic character is scanned)
1879 -- Scan to non graphic character (opened up for speed)
1881 -- Note that we just eat left brackets, which means that
1882 -- bracket notation cannot be used for end of line
1883 -- characters in comments. This seems a reasonable choice,
1884 -- since no one would ever use brackets notation in a real
1885 -- program in this situation, and if we allow brackets
1886 -- notation, we forbid some valid comments which contain a
1887 -- brackets sequence that happens to match an end of line
1891 exit when Source (Scan_Ptr) not in Graphic_Character;
1892 Scan_Ptr := Scan_Ptr + 1;
1893 exit when Source (Scan_Ptr) not in Graphic_Character;
1894 Scan_Ptr := Scan_Ptr + 1;
1895 exit when Source (Scan_Ptr) not in Graphic_Character;
1896 Scan_Ptr := Scan_Ptr + 1;
1897 exit when Source (Scan_Ptr) not in Graphic_Character;
1898 Scan_Ptr := Scan_Ptr + 1;
1899 exit when Source (Scan_Ptr) not in Graphic_Character;
1900 Scan_Ptr := Scan_Ptr + 1;
1903 -- Keep going if horizontal tab
1905 if Source (Scan_Ptr) = HT then
1910 Scan_Ptr := Scan_Ptr + 1;
1912 -- Terminate scan of comment if line terminator
1914 elsif Source (Scan_Ptr) in Line_Terminator then
1917 -- Terminate scan of comment if end of file encountered
1918 -- (embedded EOF character or real last character in file)
1920 elsif Source (Scan_Ptr) = EOF then
1923 -- If we have a wide character, we have to scan it out,
1924 -- because it might be a legitimate line terminator
1926 elsif Start_Of_Wide_Character then
1928 Wptr : constant Source_Ptr := Scan_Ptr;
1933 Scan_Wide (Source, Scan_Ptr, Code, Err);
1935 -- If not well formed wide character, then just skip
1936 -- past it and ignore it.
1939 Scan_Ptr := Wptr + 1;
1941 -- If UTF_32 terminator, terminate comment scan
1943 elsif Is_UTF_32_Line_Terminator (UTF_32 (Code)) then
1949 -- Keep going if character in 80-FF range, or is ESC. These
1950 -- characters are allowed in comments by RM-2.1(1), 2.7(2).
1951 -- They are allowed even in Ada 83 mode according to the
1952 -- approved AI. ESC was added to the AI in June 93.
1954 elsif Source (Scan_Ptr) in Upper_Half_Character
1955 or else Source (Scan_Ptr) = ESC
1957 Scan_Ptr := Scan_Ptr + 1;
1959 -- Otherwise we have an illegal comment character, ignore
1960 -- this error in relaxed semantics mode.
1963 if Relaxed_RM_Semantics then
1964 Scan_Ptr := Scan_Ptr + 1;
1966 Error_Illegal_Character;
1971 -- Note that, except when comments are tokens, we do NOT
1972 -- execute a return here, instead we fall through to reexecute
1973 -- the scan loop to look for a token.
1975 if Comment_Is_Token then
1976 Name_Len := Integer (Scan_Ptr - Start_Of_Comment);
1977 Name_Buffer (1 .. Name_Len) :=
1978 String (Source (Start_Of_Comment .. Scan_Ptr - 1));
1979 Comment_Id := Name_Find;
1980 Token := Tok_Comment;
1984 -- If the SPARK restriction is set for this unit, then generate
1985 -- a token Tok_SPARK_Hide for a SPARK HIDE directive.
1987 if Restriction_Check_Required (SPARK_05)
1988 and then Source (Start_Of_Comment) = '#'
1991 Scan_SPARK_Ptr : Source_Ptr;
1994 Scan_SPARK_Ptr := Start_Of_Comment + 1;
1998 while Source (Scan_SPARK_Ptr) = ' '
1999 or else Source (Scan_SPARK_Ptr) = HT
2001 Scan_SPARK_Ptr := Scan_SPARK_Ptr + 1;
2004 -- Recognize HIDE directive. SPARK input cannot be
2005 -- encoded as wide characters, so only deal with
2006 -- lower/upper case.
2008 if (Source (Scan_SPARK_Ptr) = 'h'
2009 or else Source (Scan_SPARK_Ptr) = 'H')
2010 and then (Source (Scan_SPARK_Ptr + 1) = 'i'
2011 or else Source (Scan_SPARK_Ptr + 1) = 'I')
2012 and then (Source (Scan_SPARK_Ptr + 2) = 'd'
2013 or else Source (Scan_SPARK_Ptr + 2) = 'D')
2014 and then (Source (Scan_SPARK_Ptr + 3) = 'e'
2015 or else Source (Scan_SPARK_Ptr + 3) = 'E')
2016 and then (Source (Scan_SPARK_Ptr + 4) = ' '
2017 or else Source (Scan_SPARK_Ptr + 4) = HT)
2019 Token := Tok_SPARK_Hide;
2027 -- Double quote or percent starting a string literal
2034 -- Apostrophe. This can either be the start of a character literal,
2035 -- or an isolated apostrophe used in a qualified expression or an
2036 -- attribute. In the following:
2038 -- A := CHARACTER'('A');
2040 -- the first apostrophe is treated as an isolated apostrophe, and the
2041 -- second one is treated as the start of the character literal 'A'.
2042 -- Note that RM-2.2(7) does not require a separator between "'" and
2043 -- "(" in the above, so we cannot use lookahead to distinguish the
2044 -- cases; we use look-back instead. Analysis of the grammar shows
2045 -- that some tokens can be followed by an apostrophe, and some by a
2046 -- character literal, but none by both. Some cannot be followed by
2047 -- either, so it doesn't matter what we do in those cases, except to
2048 -- get good error behavior.
2050 when ''' => Char_Literal_Case : declare
2055 Accumulate_Checksum (''');
2056 Scan_Ptr := Scan_Ptr + 1;
2058 -- Distinguish between apostrophe and character literal. It's an
2059 -- apostrophe if the previous token is one of the following.
2060 -- Reserved words are included for things like A.all'Address and
2061 -- T'Digits'Img. Strings literals are included for things like
2062 -- "abs"'Address. Other literals are included to give better error
2063 -- behavior for illegal cases like 123'Img.
2065 -- In Ada 2020, a target name (i.e. @) is a valid prefix of an
2066 -- attribute, and functions like a name.
2068 if Prev_Token = Tok_All
2069 or else Prev_Token = Tok_At_Sign
2070 or else Prev_Token = Tok_Delta
2071 or else Prev_Token = Tok_Digits
2072 or else Prev_Token = Tok_Identifier
2073 or else Prev_Token = Tok_Project
2074 or else Prev_Token = Tok_Right_Paren
2075 or else Prev_Token = Tok_Right_Bracket
2076 or else Prev_Token in Token_Class_Literal
2078 Token := Tok_Apostrophe;
2081 Style.Check_Apostrophe;
2086 -- Otherwise the apostrophe starts a character literal
2089 -- Case of wide character literal
2091 if Start_Of_Wide_Character then
2093 Scan_Wide (Source, Scan_Ptr, Code, Err);
2094 Accumulate_Checksum (Code);
2097 Error_Illegal_Wide_Character;
2098 Code := Character'Pos (' ');
2100 -- In Ada 95 mode we allow any wide character in a character
2101 -- literal, but in Ada 2005, the set of characters allowed
2102 -- is restricted to graphic characters.
2104 elsif Ada_Version >= Ada_2005
2105 and then Is_UTF_32_Non_Graphic (UTF_32 (Code))
2107 Error_Msg -- CODEFIX????
2108 ("(Ada 2005) non-graphic character not permitted " &
2109 "in character literal", Wptr);
2112 if Source (Scan_Ptr) /= ''' then
2113 Error_Msg_S ("missing apostrophe");
2115 Scan_Ptr := Scan_Ptr + 1;
2118 -- If we do not find a closing quote in the expected place then
2119 -- assume that we have a misguided attempt at a string literal.
2121 -- However, if previous token is RANGE, then we return an
2122 -- apostrophe instead since this gives better error recovery
2124 elsif Source (Scan_Ptr + 1) /= ''' then
2125 if Prev_Token = Tok_Range then
2126 Token := Tok_Apostrophe;
2130 Scan_Ptr := Scan_Ptr - 1;
2132 ("strings are delimited by double quote character");
2138 -- Otherwise we have a (non-wide) character literal
2141 Accumulate_Checksum (Source (Scan_Ptr));
2143 if Source (Scan_Ptr) not in Graphic_Character then
2144 if Source (Scan_Ptr) in Upper_Half_Character then
2145 if Ada_Version = Ada_83 then
2146 Error_Illegal_Character;
2150 Error_Illegal_Character;
2154 Code := Get_Char_Code (Source (Scan_Ptr));
2155 Scan_Ptr := Scan_Ptr + 2;
2158 -- Fall through here with Scan_Ptr updated past the closing
2159 -- quote, and Code set to the Char_Code value for the literal
2161 Accumulate_Checksum (''');
2162 Token := Tok_Char_Literal;
2163 Set_Character_Literal_Name (Code);
2164 Token_Name := Name_Find;
2165 Character_Code := Code;
2169 end Char_Literal_Case;
2171 -- Right parenthesis
2174 Accumulate_Checksum (')');
2175 Scan_Ptr := Scan_Ptr + 1;
2176 Token := Tok_Right_Paren;
2179 Style.Check_Right_Paren;
2184 -- Right bracket or right brace, treated as right paren but proper
2185 -- aggregate delimiter in Ada 2020.
2188 if Ada_Version >= Ada_2020 then
2189 Token := Tok_Right_Bracket;
2192 Error_Msg_S ("illegal character, replaced by "")""");
2193 Token := Tok_Right_Paren;
2196 Scan_Ptr := Scan_Ptr + 1;
2199 -- Slash (can be division operator or first character of not equal)
2202 Accumulate_Checksum ('/');
2204 if Double_Char_Token ('=') then
2205 Token := Tok_Not_Equal;
2208 Scan_Ptr := Scan_Ptr + 1;
2216 Accumulate_Checksum (';');
2217 Scan_Ptr := Scan_Ptr + 1;
2218 Token := Tok_Semicolon;
2221 Style.Check_Semicolon;
2228 when '|' => Vertical_Bar_Case : begin
2229 Accumulate_Checksum ('|');
2231 -- Special check for || to give nice message
2233 if Source (Scan_Ptr + 1) = '|' then
2234 Error_Msg_S -- CODEFIX
2235 ("""'|'|"" should be `OR ELSE`");
2236 Scan_Ptr := Scan_Ptr + 2;
2241 Scan_Ptr := Scan_Ptr + 1;
2242 Token := Tok_Vertical_Bar;
2245 Style.Check_Vertical_Bar;
2251 end Vertical_Bar_Case;
2253 -- Exclamation, replacement character for vertical bar
2255 when '!' => Exclamation_Case : begin
2256 Accumulate_Checksum ('!');
2258 if Source (Scan_Ptr + 1) = '=' then
2259 Error_Msg_S -- CODEFIX
2260 ("'!= should be /=");
2261 Scan_Ptr := Scan_Ptr + 2;
2262 Token := Tok_Not_Equal;
2266 Scan_Ptr := Scan_Ptr + 1;
2267 Token := Tok_Vertical_Bar;
2271 end Exclamation_Case;
2275 when '+' => Plus_Case : begin
2276 Accumulate_Checksum ('+');
2277 Scan_Ptr := Scan_Ptr + 1;
2282 -- Digits starting a numeric literal
2286 -- First a bit of a scan ahead to see if we have a case of an
2287 -- identifier starting with a digit (remembering exponent case).
2290 C : constant Character := Source (Scan_Ptr + 1);
2293 -- OK literal if digit followed by digit or underscore
2295 if C in '0' .. '9' or else C = '_' then
2298 -- OK literal if digit not followed by identifier char
2300 elsif not Identifier_Char (C) then
2303 -- OK literal if digit followed by e/E followed by digit/sign.
2304 -- We also allow underscore after the E, which is an error, but
2305 -- better handled by Nlit than deciding this is an identifier.
2307 elsif (C = 'e' or else C = 'E')
2308 and then (Source (Scan_Ptr + 2) in '0' .. '9'
2309 or else Source (Scan_Ptr + 2) = '+'
2310 or else Source (Scan_Ptr + 2) = '-'
2311 or else Source (Scan_Ptr + 2) = '_')
2315 -- Here we have what really looks like an identifier that
2316 -- starts with a digit, so give error msg.
2319 Error_Msg_S ("identifier may not start with digit");
2321 Underline_Found := False;
2322 Name_Buffer (1) := Source (Scan_Ptr);
2323 Accumulate_Checksum (Name_Buffer (1));
2324 Scan_Ptr := Scan_Ptr + 1;
2325 goto Scan_Identifier;
2329 -- Here we have an OK integer literal
2333 -- Check for proper delimiter, ignoring other format characters
2335 Skip_Other_Format_Characters;
2337 if Identifier_Char (Source (Scan_Ptr)) then
2339 ("delimiter required between literal and identifier");
2345 -- Lower case letters
2349 Underline_Found := False;
2350 Name_Buffer (1) := Source (Scan_Ptr);
2351 Accumulate_Checksum (Name_Buffer (1));
2352 Scan_Ptr := Scan_Ptr + 1;
2353 goto Scan_Identifier;
2355 -- Upper case letters
2359 Underline_Found := False;
2361 Character'Val (Character'Pos (Source (Scan_Ptr)) + 32);
2362 Accumulate_Checksum (Name_Buffer (1));
2363 Scan_Ptr := Scan_Ptr + 1;
2364 goto Scan_Identifier;
2366 -- Underline character
2369 if Special_Characters ('_') then
2370 Token_Ptr := Scan_Ptr;
2371 Scan_Ptr := Scan_Ptr + 1;
2372 Token := Tok_Special;
2373 Special_Character := '_';
2377 Error_Msg_S ("identifier cannot start with underline");
2379 Name_Buffer (1) := '_';
2380 Scan_Ptr := Scan_Ptr + 1;
2381 Underline_Found := False;
2382 goto Scan_Identifier;
2384 -- Space (not possible, because we scanned past blanks)
2387 raise Program_Error;
2389 -- Characters in top half of ASCII 8-bit chart
2391 when Upper_Half_Character =>
2393 -- Wide character case
2395 if Upper_Half_Encoding then
2396 goto Scan_Wide_Character;
2398 -- Otherwise we have OK Latin-1 character
2401 -- Upper half characters may possibly be identifier letters
2402 -- but can never be digits, so Identifier_Char can be used to
2403 -- test for a valid start of identifier character.
2405 if Identifier_Char (Source (Scan_Ptr)) then
2407 Underline_Found := False;
2408 goto Scan_Identifier;
2410 Error_Illegal_Character;
2416 -- ESC character, possible start of identifier if wide characters
2417 -- using ESC encoding are allowed in identifiers, which we can
2418 -- tell by looking at the Identifier_Char flag for ESC, which is
2419 -- only true if these conditions are met. In Ada 2005 mode, may
2420 -- also be valid UTF_32 space or line terminator character.
2422 if Identifier_Char (ESC) then
2424 goto Scan_Wide_Character;
2426 Error_Illegal_Character;
2429 -- Invalid control characters
2458 Error_Illegal_Character;
2460 -- Invalid graphic characters
2461 -- Note that '@' is handled elsewhere, because following AI12-125
2462 -- it denotes the target_name of an assignment.
2464 when '#' | '$' | '?' | '`' | '\' | '^' | '~' =>
2466 -- If Set_Special_Character has been called for this character,
2467 -- set Scans.Special_Character and return a Special token.
2469 if Special_Characters (Source (Scan_Ptr)) then
2470 Token_Ptr := Scan_Ptr;
2471 Token := Tok_Special;
2472 Special_Character := Source (Scan_Ptr);
2473 Scan_Ptr := Scan_Ptr + 1;
2476 -- Check for something looking like a preprocessor directive
2478 elsif Source (Scan_Ptr) = '#'
2479 and then (Source (Scan_Ptr + 1 .. Scan_Ptr + 2) = "if"
2481 Source (Scan_Ptr + 1 .. Scan_Ptr + 5) = "elsif"
2483 Source (Scan_Ptr + 1 .. Scan_Ptr + 4) = "else"
2485 Source (Scan_Ptr + 1 .. Scan_Ptr + 3) = "end")
2488 ("preprocessor directive ignored, preprocessor not active");
2490 -- Skip to end of line
2493 if Source (Scan_Ptr) in Graphic_Character
2495 Source (Scan_Ptr) = HT
2497 Scan_Ptr := Scan_Ptr + 1;
2499 -- Done if line terminator or EOF
2501 elsif Source (Scan_Ptr) in Line_Terminator
2503 Source (Scan_Ptr) = EOF
2507 -- If we have a wide character, we have to scan it out,
2508 -- because it might be a legitimate line terminator
2510 elsif Start_Of_Wide_Character then
2512 Wptr : constant Source_Ptr := Scan_Ptr;
2517 Scan_Wide (Source, Scan_Ptr, Code, Err);
2519 -- If not well formed wide character, then just skip
2520 -- past it and ignore it.
2523 Scan_Ptr := Wptr + 1;
2525 -- If UTF_32 terminator, terminate comment scan
2527 elsif Is_UTF_32_Line_Terminator (UTF_32 (Code)) then
2533 -- Else keep going (don't worry about bad comment chars
2534 -- in this context, we just want to find the end of line.
2537 Scan_Ptr := Scan_Ptr + 1;
2541 -- Otherwise, this is an illegal character
2544 Error_Illegal_Character;
2547 -- End switch on non-blank character
2551 -- End loop past format effectors. The exit from this loop is by
2552 -- executing a return statement following completion of token scan
2553 -- (control never falls out of this loop to the code that follows).
2557 pragma Assert (False);
2559 -- Wide_Character scanning routine. On entry we have encountered the
2560 -- initial character of a wide character sequence.
2562 <<Scan_Wide_Character>>
2570 Scan_Wide (Source, Scan_Ptr, Code, Err);
2572 -- If bad wide character, signal error and continue scan
2575 Error_Illegal_Wide_Character;
2576 goto Scan_Next_Character;
2579 Cat := Get_Category (UTF_32 (Code));
2581 -- If OK letter, reset scan ptr and go scan identifier
2583 if Is_UTF_32_Letter (Cat) then
2586 Underline_Found := False;
2587 goto Scan_Identifier;
2589 -- If OK wide space, ignore and keep scanning (we do not include
2590 -- any ignored spaces in checksum)
2592 elsif Is_UTF_32_Space (Cat) then
2593 goto Scan_Next_Character;
2595 -- If other format character, ignore and keep scanning (again we
2596 -- do not include in the checksum) (this is for AI-0079).
2598 elsif Is_UTF_32_Other (Cat) then
2599 goto Scan_Next_Character;
2601 -- If OK wide line terminator, terminate current line
2603 elsif Is_UTF_32_Line_Terminator (UTF_32 (Code)) then
2605 goto Scan_Line_Terminator;
2607 -- Punctuation is an error (at start of identifier)
2609 elsif Is_UTF_32_Punctuation (Cat) then
2610 Error_Msg ("identifier cannot start with punctuation", Wptr);
2613 Underline_Found := False;
2614 goto Scan_Identifier;
2616 -- Mark character is an error (at start of identifier)
2618 elsif Is_UTF_32_Mark (Cat) then
2619 Error_Msg ("identifier cannot start with mark character", Wptr);
2622 Underline_Found := False;
2623 goto Scan_Identifier;
2625 -- Extended digit character is an error. Could be bad start of
2626 -- identifier or bad literal. Not worth doing too much to try to
2627 -- distinguish these cases, but we will do a little bit.
2629 elsif Is_UTF_32_Digit (Cat) then
2631 ("identifier cannot start with digit character", Wptr);
2634 Underline_Found := False;
2635 goto Scan_Identifier;
2637 -- All other wide characters are illegal here
2640 Error_Illegal_Wide_Character;
2641 goto Scan_Next_Character;
2645 -- Routine to scan line terminator. On entry Scan_Ptr points to a
2646 -- character which is one of FF,LR,CR,VT, or one of the wide characters
2647 -- that is treated as a line terminator.
2649 <<Scan_Line_Terminator>>
2651 -- Check line too long
2655 -- Set Token_Ptr, if End_Of_Line is a token, for the case when it is
2658 if End_Of_Line_Is_Token then
2659 Token_Ptr := Scan_Ptr;
2666 Skip_Line_Terminators (Scan_Ptr, Physical);
2668 -- If we are at start of physical line, update scan pointers to
2669 -- reflect the start of the new line.
2672 Current_Line_Start := Scan_Ptr;
2673 Start_Column := Set_Start_Column;
2674 First_Non_Blank_Location := Scan_Ptr;
2676 -- If End_Of_Line is a token, we return it as it is a
2679 if End_Of_Line_Is_Token then
2680 Token := Tok_End_Of_Line;
2686 goto Scan_Next_Character;
2688 -- Identifier scanning routine. On entry, some initial characters of
2689 -- the identifier may have already been stored in Name_Buffer. If so,
2690 -- Name_Len has the number of characters stored, otherwise Name_Len is
2691 -- set to zero on entry. Underline_Found is also set False on entry.
2695 -- This loop scans as fast as possible past lower half letters and
2696 -- digits, which we expect to be the most common characters.
2699 if Source (Scan_Ptr) in 'a' .. 'z'
2700 or else Source (Scan_Ptr) in '0' .. '9'
2702 Name_Buffer (Name_Len + 1) := Source (Scan_Ptr);
2703 Accumulate_Checksum (Source (Scan_Ptr));
2705 elsif Source (Scan_Ptr) in 'A' .. 'Z' then
2706 Name_Buffer (Name_Len + 1) :=
2707 Character'Val (Character'Pos (Source (Scan_Ptr)) + 32);
2708 Accumulate_Checksum (Name_Buffer (Name_Len + 1));
2714 Underline_Found := False;
2715 Scan_Ptr := Scan_Ptr + 1;
2716 Name_Len := Name_Len + 1;
2719 -- If we fall through, then we have encountered either an underline
2720 -- character, or an extended identifier character (i.e. one from the
2721 -- upper half), or a wide character, or an identifier terminator. The
2722 -- initial test speeds us up in the most common case where we have
2723 -- an identifier terminator. Note that ESC is an identifier character
2724 -- only if a wide character encoding method that uses ESC encoding
2725 -- is active, so if we find an ESC character we know that we have a
2728 if Identifier_Char (Source (Scan_Ptr))
2729 or else (Source (Scan_Ptr) in Upper_Half_Character
2730 and then Upper_Half_Encoding)
2732 -- Case of underline
2734 if Source (Scan_Ptr) = '_' then
2735 Accumulate_Checksum ('_');
2737 if Underline_Found then
2738 Error_No_Double_Underline;
2740 Underline_Found := True;
2741 Name_Len := Name_Len + 1;
2742 Name_Buffer (Name_Len) := '_';
2745 Scan_Ptr := Scan_Ptr + 1;
2746 goto Scan_Identifier;
2748 -- Upper half character
2750 elsif Source (Scan_Ptr) in Upper_Half_Character
2751 and then not Upper_Half_Encoding
2753 Accumulate_Checksum (Source (Scan_Ptr));
2754 Store_Encoded_Character
2755 (Get_Char_Code (Fold_Lower (Source (Scan_Ptr))));
2756 Scan_Ptr := Scan_Ptr + 1;
2757 Underline_Found := False;
2758 goto Scan_Identifier;
2760 -- Left bracket not followed by a quote terminates an identifier.
2761 -- This is an error, but we don't want to give a junk error msg
2762 -- about wide characters in this case.
2764 elsif Source (Scan_Ptr) = '['
2765 and then Source (Scan_Ptr + 1) /= '"'
2769 -- We know we have a wide character encoding here (the current
2770 -- character is either ESC, left bracket, or an upper half
2771 -- character depending on the encoding method).
2774 -- Scan out the wide character and insert the appropriate
2775 -- encoding into the name table entry for the identifier.
2785 Scan_Wide (Source, Scan_Ptr, Code, Err);
2787 -- If error, signal error
2790 Error_Illegal_Wide_Character;
2792 -- If the character scanned is a normal identifier
2793 -- character, then we treat it that way.
2795 elsif In_Character_Range (Code)
2796 and then Identifier_Char (Get_Character (Code))
2798 Chr := Get_Character (Code);
2799 Accumulate_Checksum (Chr);
2800 Store_Encoded_Character
2801 (Get_Char_Code (Fold_Lower (Chr)));
2802 Underline_Found := False;
2804 -- Here if not a normal identifier character
2807 Cat := Get_Category (UTF_32 (Code));
2809 -- Wide character in Unicode category "Other, Format"
2810 -- is not accepted in an identifier. This is because it
2811 -- it is considered a security risk (AI-0091).
2813 -- However, it is OK for such a character to appear at
2814 -- the end of an identifier.
2816 if Is_UTF_32_Other (Cat) then
2817 if not Identifier_Char (Source (Scan_Ptr)) then
2818 goto Scan_Identifier_Complete;
2821 ("identifier cannot contain other_format "
2822 & "character", Wptr);
2823 goto Scan_Identifier;
2826 -- Wide character in category Separator,Space terminates
2828 elsif Is_UTF_32_Space (Cat) then
2829 goto Scan_Identifier_Complete;
2832 -- Here if wide character is part of the identifier
2834 -- Make sure we are allowing wide characters in
2835 -- identifiers. Note that we allow wide character
2836 -- notation for an OK identifier character. This in
2837 -- particular allows bracket or other notation to be
2838 -- used for upper half letters.
2840 -- Wide characters are always allowed in Ada 2005
2842 if Identifier_Character_Set /= 'w'
2843 and then Ada_Version < Ada_2005
2846 ("wide character not allowed in identifier", Wptr);
2849 -- If OK letter, store it folding to upper case. Note
2850 -- that we include the folded letter in the checksum.
2852 if Is_UTF_32_Letter (Cat) then
2854 Char_Code (UTF_32_To_Upper_Case (UTF_32 (Code)));
2855 Accumulate_Checksum (Code);
2856 Store_Encoded_Character (Code);
2857 Underline_Found := False;
2859 -- If OK extended digit or mark, then store it
2861 elsif Is_UTF_32_Digit (Cat)
2862 or else Is_UTF_32_Mark (Cat)
2864 Accumulate_Checksum (Code);
2865 Store_Encoded_Character (Code);
2866 Underline_Found := False;
2868 -- Wide punctuation is also stored, but counts as an
2869 -- underline character for error checking purposes.
2871 elsif Is_UTF_32_Punctuation (Cat) then
2872 Accumulate_Checksum (Code);
2874 if Underline_Found then
2876 Cend : constant Source_Ptr := Scan_Ptr;
2879 Error_No_Double_Underline;
2884 Store_Encoded_Character (Code);
2885 Underline_Found := True;
2888 -- Any other wide character is not acceptable
2892 ("invalid wide character in identifier", Wptr);
2896 goto Scan_Identifier;
2901 -- Scan of identifier is complete. The identifier is stored in
2902 -- Name_Buffer, and Scan_Ptr points past the last character.
2904 <<Scan_Identifier_Complete>>
2905 Token_Name := Name_Find;
2907 -- Check for identifier ending with underline or punctuation char
2909 if Underline_Found then
2910 Underline_Found := False;
2912 if Source (Scan_Ptr - 1) = '_' then
2914 ("identifier cannot end with underline", Scan_Ptr - 1);
2917 ("identifier cannot end with punctuation character", Wptr);
2921 -- We will assume it is an identifier, not a keyword, so that the
2922 -- checksum is independent of the Ada version.
2924 Token := Tok_Identifier;
2926 -- Here is where we check if it was a keyword
2928 if Is_Keyword_Name (Token_Name) then
2929 if Opt.Checksum_GNAT_6_3 then
2930 Token := Token_Type'Val (Get_Name_Table_Byte (Token_Name));
2932 if Checksum_Accumulate_Token_Checksum then
2933 if Checksum_GNAT_5_03 then
2934 Accumulate_Token_Checksum_GNAT_5_03;
2936 Accumulate_Token_Checksum_GNAT_6_3;
2941 Accumulate_Token_Checksum;
2942 Token := Token_Type'Val (Get_Name_Table_Byte (Token_Name));
2945 -- Keyword style checks
2949 -- Deal with possible style check for non-lower case keyword,
2950 -- but we don't treat ACCESS, DELTA, DIGITS, RANGE as keywords
2951 -- for this purpose if they appear as attribute designators.
2952 -- Actually we only check the first character for speed.
2954 -- Ada 2005 (AI-284): Do not apply the style check in case of
2955 -- "pragma Interface"
2957 -- Ada 2005 (AI-340): Do not apply the style check in case of
2960 if Source (Token_Ptr) <= 'Z'
2961 and then (Prev_Token /= Tok_Apostrophe
2963 (Token /= Tok_Access and then
2964 Token /= Tok_Delta and then
2965 Token /= Tok_Digits and then
2966 Token /= Tok_Mod and then
2967 Token /= Tok_Range))
2968 and then (Token /= Tok_Interface
2970 (Token = Tok_Interface
2971 and then Prev_Token /= Tok_Pragma))
2973 Style.Non_Lower_Case_Keyword;
2976 -- Check THEN/ELSE style rules. These do not apply to AND THEN
2977 -- or OR ELSE, and do not apply in if expressions.
2979 if (Token = Tok_Then and then Prev_Token /= Tok_And)
2981 (Token = Tok_Else and then Prev_Token /= Tok_Or)
2983 if Inside_If_Expression = 0 then
2984 Style.Check_Separate_Stmt_Lines;
2989 -- We must reset Token_Name since this is not an identifier and
2990 -- if we leave Token_Name set, the parser gets confused because
2991 -- it thinks it is dealing with an identifier instead of the
2992 -- corresponding keyword.
2994 Token_Name := No_Name;
2997 -- It is an identifier after all
3000 if Checksum_Accumulate_Token_Checksum then
3001 Accumulate_Token_Checksum;
3009 --------------------------
3010 -- Set_Comment_As_Token --
3011 --------------------------
3013 procedure Set_Comment_As_Token (Value : Boolean) is
3015 Comment_Is_Token := Value;
3016 end Set_Comment_As_Token;
3018 ------------------------------
3019 -- Set_End_Of_Line_As_Token --
3020 ------------------------------
3022 procedure Set_End_Of_Line_As_Token (Value : Boolean) is
3024 End_Of_Line_Is_Token := Value;
3025 end Set_End_Of_Line_As_Token;
3027 ---------------------------
3028 -- Set_Special_Character --
3029 ---------------------------
3031 procedure Set_Special_Character (C : Character) is
3034 when '#' | '$' | '_' | '?' | '@' | '`' | '\' | '^' | '~' =>
3035 Special_Characters (C) := True;
3040 end Set_Special_Character;
3042 ----------------------
3043 -- Set_Start_Column --
3044 ----------------------
3046 -- Note: it seems at first glance a little expensive to compute this value
3047 -- for every source line (since it is certainly not used for all source
3048 -- lines). On the other hand, it doesn't take much more work to skip past
3049 -- the initial white space on the line counting the columns than it would
3050 -- to scan past the white space using the standard scanning circuits.
3052 function Set_Start_Column return Column_Number is
3053 Start_Column : Column_Number := 0;
3056 -- Outer loop scans past horizontal tab characters
3060 -- Inner loop scans past blanks as fast as possible, bumping Scan_Ptr
3061 -- past the blanks and adjusting Start_Column to account for them.
3064 if Source (Scan_Ptr) = ' ' then
3065 if Source (Scan_Ptr + 1) = ' ' then
3066 if Source (Scan_Ptr + 2) = ' ' then
3067 if Source (Scan_Ptr + 3) = ' ' then
3068 if Source (Scan_Ptr + 4) = ' ' then
3069 if Source (Scan_Ptr + 5) = ' ' then
3070 if Source (Scan_Ptr + 6) = ' ' then
3071 Scan_Ptr := Scan_Ptr + 7;
3072 Start_Column := Start_Column + 7;
3074 Scan_Ptr := Scan_Ptr + 6;
3075 Start_Column := Start_Column + 6;
3079 Scan_Ptr := Scan_Ptr + 5;
3080 Start_Column := Start_Column + 5;
3084 Scan_Ptr := Scan_Ptr + 4;
3085 Start_Column := Start_Column + 4;
3089 Scan_Ptr := Scan_Ptr + 3;
3090 Start_Column := Start_Column + 3;
3094 Scan_Ptr := Scan_Ptr + 2;
3095 Start_Column := Start_Column + 2;
3099 Scan_Ptr := Scan_Ptr + 1;
3100 Start_Column := Start_Column + 1;
3106 end loop Blanks_Loop;
3108 -- Outer loop keeps going only if a horizontal tab follows
3110 if Source (Scan_Ptr) = HT then
3115 Scan_Ptr := Scan_Ptr + 1;
3116 Start_Column := (Start_Column / 8) * 8 + 8;
3122 return Start_Column;
3124 -- A constraint error can happen only if we have a compiler with checks on
3125 -- and a line with a ludicrous number of tabs or spaces at the start. In
3126 -- such a case, we really don't care if Start_Column is right or not.
3129 when Constraint_Error =>
3130 return Start_Column;
3131 end Set_Start_Column;
projects / thirdparty / gcc.git / blob