| ------------------------------------------------------------------------------ |
| -- -- |
| -- GNAT COMPILER COMPONENTS -- |
| -- -- |
| -- P A R . U T I L -- |
| -- -- |
| -- B o d y -- |
| -- -- |
| -- Copyright (C) 1992-2022, Free Software Foundation, Inc. -- |
| -- -- |
| -- GNAT is free software; you can redistribute it and/or modify it under -- |
| -- terms of the GNU General Public License as published by the Free Soft- -- |
| -- ware Foundation; either version 3, or (at your option) any later ver- -- |
| -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- |
| -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- |
| -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- |
| -- for more details. You should have received a copy of the GNU General -- |
| -- Public License distributed with GNAT; see file COPYING3. If not, go to -- |
| -- http://www.gnu.org/licenses for a complete copy of the license. -- |
| -- -- |
| -- GNAT was originally developed by the GNAT team at New York University. -- |
| -- Extensive contributions were provided by Ada Core Technologies Inc. -- |
| -- -- |
| ------------------------------------------------------------------------------ |
| |
| with Csets; use Csets; |
| with Namet.Sp; use Namet.Sp; |
| with Stylesw; use Stylesw; |
| with Uintp; use Uintp; |
| with Warnsw; use Warnsw; |
| |
| with GNAT.Spelling_Checker; use GNAT.Spelling_Checker; |
| |
| separate (Par) |
| package body Util is |
| |
| --------------------- |
| -- Bad_Spelling_Of -- |
| --------------------- |
| |
| function Bad_Spelling_Of (T : Token_Type) return Boolean is |
| Tname : constant String := Token_Type'Image (T); |
| -- Characters of token name |
| |
| S : String (1 .. Tname'Last - 4); |
| -- Characters of token name folded to lower case, omitting TOK_ at start |
| |
| M1 : String (1 .. 42) := "incorrect spelling of keyword ************"; |
| M2 : String (1 .. 44) := "illegal abbreviation of keyword ************"; |
| -- Buffers used to construct error message |
| |
| P1 : constant := 30; |
| P2 : constant := 32; |
| -- Starting subscripts in M1, M2 for keyword name |
| |
| SL : constant Natural := S'Length; |
| -- Length of expected token name excluding TOK_ at start |
| |
| begin |
| if Token /= Tok_Identifier then |
| return False; |
| end if; |
| |
| for J in S'Range loop |
| S (J) := Fold_Lower (Tname (J + 4)); |
| end loop; |
| |
| Get_Name_String (Token_Name); |
| |
| -- A special check for case of PROGRAM used for PROCEDURE |
| |
| if T = Tok_Procedure |
| and then Name_Len = 7 |
| and then Name_Buffer (1 .. 7) = "program" |
| then |
| Error_Msg_SC -- CODEFIX |
| ("PROCEDURE expected"); |
| Token := T; |
| return True; |
| |
| -- A special check for an illegal abbreviation |
| |
| elsif Name_Len < S'Length |
| and then Name_Len >= 4 |
| and then Name_Buffer (1 .. Name_Len) = S (1 .. Name_Len) |
| then |
| for J in 1 .. S'Last loop |
| M2 (P2 + J - 1) := Fold_Upper (S (J)); |
| end loop; |
| |
| Error_Msg_SC (M2 (1 .. P2 - 1 + S'Last)); |
| Token := T; |
| return True; |
| end if; |
| |
| -- Now we go into the full circuit to check for a misspelling |
| |
| -- Never consider something a misspelling if either the actual or |
| -- expected string is less than 3 characters (before this check we |
| -- used to consider i to be a misspelled if in some cases). |
| |
| if SL < 3 or else Name_Len < 3 then |
| return False; |
| |
| -- Special case: prefix matches, i.e. the leading characters of the |
| -- token that we have exactly match the required keyword. If there |
| -- are at least two characters left over, assume that we have a case |
| -- of two keywords joined together which should not be joined. |
| |
| elsif Name_Len > SL + 1 |
| and then S = Name_Buffer (1 .. SL) |
| then |
| Scan_Ptr := Token_Ptr + S'Length; |
| Error_Msg_S ("|missing space"); |
| Token := T; |
| return True; |
| end if; |
| |
| if Is_Bad_Spelling_Of (Name_Buffer (1 .. Name_Len), S) then |
| for J in 1 .. S'Last loop |
| M1 (P1 + J - 1) := Fold_Upper (S (J)); |
| end loop; |
| |
| Error_Msg_SC -- CODFIX |
| (M1 (1 .. P1 - 1 + S'Last)); |
| Token := T; |
| return True; |
| |
| else |
| return False; |
| end if; |
| end Bad_Spelling_Of; |
| |
| ---------------------- |
| -- Check_95_Keyword -- |
| ---------------------- |
| |
| -- On entry, the caller has checked that current token is an identifier |
| -- whose name matches the name of the 95 keyword New_Tok. |
| |
| procedure Check_95_Keyword (Token_95, Next : Token_Type) is |
| Scan_State : Saved_Scan_State; |
| |
| begin |
| Save_Scan_State (Scan_State); -- at identifier/keyword |
| Scan; -- past identifier/keyword |
| |
| if Token = Next then |
| Restore_Scan_State (Scan_State); -- to identifier |
| Error_Msg_Name_1 := Token_Name; |
| Error_Msg_SC ("(Ada 83) keyword* cannot be used!"); |
| Token := Token_95; |
| else |
| Restore_Scan_State (Scan_State); -- to identifier |
| end if; |
| end Check_95_Keyword; |
| |
| ---------------------- |
| -- Check_Bad_Layout -- |
| ---------------------- |
| |
| procedure Check_Bad_Layout is |
| begin |
| if RM_Column_Check and then Token_Is_At_Start_Of_Line |
| and then Start_Column <= Scopes (Scope.Last).Ecol |
| then |
| Error_Msg_BC -- CODEFIX |
| ("(style) incorrect layout"); |
| end if; |
| end Check_Bad_Layout; |
| |
| -------------------------- |
| -- Check_Future_Keyword -- |
| -------------------------- |
| |
| procedure Check_Future_Keyword is |
| begin |
| -- Ada 2005 (AI-284): Compiling in Ada 95 mode we warn that INTERFACE, |
| -- OVERRIDING, and SYNCHRONIZED are new reserved words. |
| |
| if Ada_Version = Ada_95 |
| and then Warn_On_Ada_2005_Compatibility |
| then |
| if Token_Name in Name_Overriding | Name_Synchronized |
| or else (Token_Name = Name_Interface |
| and then Prev_Token /= Tok_Pragma) |
| then |
| Error_Msg_N ("& is a reserved word in Ada 2005?y?", Token_Node); |
| end if; |
| end if; |
| |
| -- Similarly, warn about Ada 2012 reserved words |
| |
| if Ada_Version in Ada_95 .. Ada_2005 |
| and then Warn_On_Ada_2012_Compatibility |
| then |
| if Token_Name = Name_Some then |
| Error_Msg_N ("& is a reserved word in Ada 2012?y?", Token_Node); |
| end if; |
| end if; |
| |
| -- Note: we deliberately do not emit these warnings when operating in |
| -- Ada 83 mode because in that case we assume the user is building |
| -- legacy code anyway and is not interested in updating Ada versions. |
| |
| end Check_Future_Keyword; |
| |
| -------------------------- |
| -- Check_Misspelling_Of -- |
| -------------------------- |
| |
| procedure Check_Misspelling_Of (T : Token_Type) is |
| begin |
| if Bad_Spelling_Of (T) then |
| null; |
| end if; |
| end Check_Misspelling_Of; |
| |
| ----------------------------- |
| -- Check_Simple_Expression -- |
| ----------------------------- |
| |
| procedure Check_Simple_Expression (E : Node_Id) is |
| begin |
| if Expr_Form = EF_Non_Simple then |
| Error_Msg_N ("this expression must be parenthesized", E); |
| end if; |
| end Check_Simple_Expression; |
| |
| --------------------------------------- |
| -- Check_Simple_Expression_In_Ada_83 -- |
| --------------------------------------- |
| |
| procedure Check_Simple_Expression_In_Ada_83 (E : Node_Id) is |
| begin |
| if Expr_Form = EF_Non_Simple then |
| if Ada_Version = Ada_83 then |
| Error_Msg_N ("(Ada 83) this expression must be parenthesized!", E); |
| end if; |
| end if; |
| end Check_Simple_Expression_In_Ada_83; |
| |
| ------------------------ |
| -- Check_Subtype_Mark -- |
| ------------------------ |
| |
| function Check_Subtype_Mark (Mark : Node_Id) return Node_Id is |
| begin |
| if Nkind (Mark) = N_Identifier |
| or else Nkind (Mark) = N_Selected_Component |
| or else (Nkind (Mark) = N_Attribute_Reference |
| and then Is_Type_Attribute_Name (Attribute_Name (Mark))) |
| or else Mark = Error |
| then |
| return Mark; |
| else |
| Error_Msg_N ("subtype mark expected", Mark); |
| return Error; |
| end if; |
| end Check_Subtype_Mark; |
| |
| ------------------- |
| -- Comma_Present -- |
| ------------------- |
| |
| function Comma_Present return Boolean is |
| Scan_State : Saved_Scan_State; |
| Paren_Count : Nat; |
| |
| begin |
| -- First check, if a comma is present, then a comma is present |
| |
| if Token = Tok_Comma then |
| T_Comma; |
| return True; |
| |
| -- If we have a right paren, then that is taken as ending the list |
| -- i.e. no comma is present. |
| -- Ditto for a right bracket in Ada 2022. |
| |
| elsif Token = Tok_Right_Paren |
| or else (Token = Tok_Right_Bracket and then Ada_Version >= Ada_2022) |
| then |
| return False; |
| |
| -- If pragmas, then get rid of them and make a recursive call |
| -- to process what follows these pragmas. |
| |
| elsif Token = Tok_Pragma then |
| P_Pragmas_Misplaced; |
| return Comma_Present; |
| |
| -- At this stage we have an error, and the goal is to decide on whether |
| -- or not we should diagnose an error and report a (non-existent) |
| -- comma as being present, or simply to report no comma is present |
| |
| -- If we are a semicolon, then the question is whether we have a missing |
| -- right paren, or whether the semicolon should have been a comma. To |
| -- guess the right answer, we scan ahead keeping track of the paren |
| -- level, looking for a clue that helps us make the right decision. |
| |
| -- This approach is highly accurate in the single error case, and does |
| -- not make bad mistakes in the multiple error case (indeed we can't |
| -- really make a very bad decision at this point in any case). |
| |
| elsif Token = Tok_Semicolon then |
| Save_Scan_State (Scan_State); |
| Scan; -- past semicolon |
| |
| -- Check for being followed by identifier => which almost certainly |
| -- means we are still in a parameter list and the comma should have |
| -- been a semicolon (such a sequence could not follow a semicolon) |
| |
| if Token = Tok_Identifier then |
| Scan; |
| |
| if Token = Tok_Arrow then |
| goto Assume_Comma; |
| end if; |
| end if; |
| |
| -- If that test didn't work, loop ahead looking for a comma or |
| -- semicolon at the same parenthesis level. Always remember that |
| -- we can't go badly wrong in an error situation like this. |
| |
| Paren_Count := 0; |
| |
| -- Here is the look ahead loop, Paren_Count tells us whether the |
| -- token we are looking at is at the same paren level as the |
| -- suspicious semicolon that we are trying to figure out. |
| |
| loop |
| |
| -- If we hit another semicolon or an end of file, and we have |
| -- not seen a right paren or another comma on the way, then |
| -- probably the semicolon did end the list. Indeed that is |
| -- certainly the only single error correction possible here. |
| |
| if Token in Tok_Semicolon | Tok_EOF then |
| Restore_Scan_State (Scan_State); |
| return False; |
| |
| -- A comma at the same paren level as the semicolon is a strong |
| -- indicator that the semicolon should have been a comma, indeed |
| -- again this is the only possible single error correction. |
| |
| elsif Token = Tok_Comma then |
| exit when Paren_Count = 0; |
| |
| -- A left paren just bumps the paren count |
| |
| elsif Token = Tok_Left_Paren then |
| Paren_Count := Paren_Count + 1; |
| |
| -- A right paren that is at the same paren level as the semicolon |
| -- also means that the only possible single error correction is |
| -- to assume that the semicolon should have been a comma. If we |
| -- are not at the same paren level, then adjust the paren level. |
| |
| elsif Token = Tok_Right_Paren then |
| exit when Paren_Count = 0; |
| Paren_Count := Paren_Count - 1; |
| end if; |
| |
| -- Keep going, we haven't made a decision yet |
| |
| Scan; |
| end loop; |
| |
| -- If we fall through the loop, it means that we found a terminating |
| -- right paren or another comma. In either case it is reasonable to |
| -- assume that the semicolon was really intended to be a comma. Also |
| -- come here for the identifier arrow case. |
| |
| <<Assume_Comma>> |
| Restore_Scan_State (Scan_State); |
| Error_Msg_SC -- CODEFIX |
| ("|"";"" should be "","""); |
| Scan; -- past the semicolon |
| return True; |
| |
| -- If we are not at semicolon or a right paren, then we base the |
| -- decision on whether or not the next token can be part of an |
| -- expression. If not, then decide that no comma is present (the |
| -- caller will eventually generate a missing right parent message) |
| |
| elsif Token in Token_Class_Eterm then |
| return False; |
| |
| -- Otherwise we assume a comma is present, even if none is present, |
| -- since the next token must be part of an expression, so if we were |
| -- at the end of the list, then there is more than one error present. |
| |
| else |
| T_Comma; -- to give error |
| return True; |
| end if; |
| end Comma_Present; |
| |
| ----------------------- |
| -- Discard_Junk_List -- |
| ----------------------- |
| |
| procedure Discard_Junk_List (L : List_Id) is |
| pragma Warnings (Off, L); |
| begin |
| null; |
| end Discard_Junk_List; |
| |
| ----------------------- |
| -- Discard_Junk_Node -- |
| ----------------------- |
| |
| procedure Discard_Junk_Node (N : Node_Id) is |
| pragma Warnings (Off, N); |
| begin |
| null; |
| end Discard_Junk_Node; |
| |
| ------------ |
| -- Ignore -- |
| ------------ |
| |
| procedure Ignore (T : Token_Type) is |
| begin |
| while Token = T loop |
| if T = Tok_Comma then |
| Error_Msg_SC -- CODEFIX |
| ("|extra "","" ignored"); |
| |
| elsif T = Tok_Left_Paren then |
| Error_Msg_SC -- CODEFIX |
| ("|extra ""("" ignored"); |
| |
| -- Note: the following error used to be labeled as a non-serious |
| -- error like the other similar messages here (with a | at the start |
| -- of the message). But this caused some annoying cascaded errors |
| -- that were confusing, as shown by this example: |
| |
| -- A : array (1 .. 9) of Integer := |
| -- ((1 .. 2) => 0, |
| -- 1 2 3 |
| -- >>> positional aggregate cannot have one component |
| -- >>> named association cannot follow positional association |
| -- >>> extra ")" ignored |
| |
| -- So we decided to label it as serious after all |
| |
| elsif T = Tok_Right_Paren then |
| Error_Msg_SC -- CODEFIX |
| ("extra "")"" ignored"); |
| |
| elsif T = Tok_Semicolon then |
| Error_Msg_SC -- CODEFIX |
| ("|extra "";"" ignored"); |
| |
| elsif T = Tok_Colon then |
| Error_Msg_SC -- CODEFIX |
| ("|extra "":"" ignored"); |
| |
| else |
| declare |
| Tname : constant String := Token_Type'Image (Token); |
| begin |
| Error_Msg_SC ("|extra " & Tname (5 .. Tname'Last) & " ignored"); |
| end; |
| end if; |
| |
| Scan; -- Scan past ignored token |
| end loop; |
| end Ignore; |
| |
| ---------------------------- |
| -- Is_Reserved_Identifier -- |
| ---------------------------- |
| |
| function Is_Reserved_Identifier (C : Id_Check := None) return Boolean is |
| begin |
| if not Is_Reserved_Keyword (Token) then |
| return False; |
| |
| else |
| declare |
| Ident_Casing : constant Casing_Type := |
| Identifier_Casing (Current_Source_File); |
| Key_Casing : constant Casing_Type := |
| Keyword_Casing (Current_Source_File); |
| |
| begin |
| -- If the casing of identifiers and keywords is different in |
| -- this source file, and the casing of this token matches the |
| -- keyword casing, then we return False, since it is pretty |
| -- clearly intended to be a keyword. |
| |
| if Ident_Casing = Unknown |
| or else Key_Casing = Unknown |
| or else Ident_Casing = Key_Casing |
| or else Determine_Token_Casing /= Key_Casing |
| then |
| return True; |
| |
| -- Here we have a keyword written clearly with keyword casing. |
| -- In default mode, we would not be willing to consider this as |
| -- a reserved identifier, but if C is set, we may still accept it |
| |
| elsif C /= None then |
| declare |
| Scan_State : Saved_Scan_State; |
| OK_Next_Tok : Boolean; |
| |
| begin |
| Save_Scan_State (Scan_State); |
| Scan; |
| |
| if Token_Is_At_Start_Of_Line then |
| return False; |
| end if; |
| |
| case C is |
| when None => |
| raise Program_Error; |
| |
| when C_Comma_Right_Paren => |
| OK_Next_Tok := Token in Tok_Comma | Tok_Right_Paren; |
| |
| when C_Comma_Colon => |
| OK_Next_Tok := Token in Tok_Comma | Tok_Colon; |
| |
| when C_Do => |
| OK_Next_Tok := Token = Tok_Do; |
| |
| when C_Dot => |
| OK_Next_Tok := Token = Tok_Dot; |
| |
| when C_Greater_Greater => |
| OK_Next_Tok := Token = Tok_Greater_Greater; |
| |
| when C_In => |
| OK_Next_Tok := Token = Tok_In; |
| |
| when C_Is => |
| OK_Next_Tok := Token = Tok_Is; |
| |
| when C_Left_Paren_Semicolon => |
| OK_Next_Tok := Token in Tok_Left_Paren | Tok_Semicolon; |
| |
| when C_Use => |
| OK_Next_Tok := Token = Tok_Use; |
| |
| when C_Vertical_Bar_Arrow => |
| OK_Next_Tok := Token in Tok_Vertical_Bar | Tok_Arrow; |
| end case; |
| |
| Restore_Scan_State (Scan_State); |
| |
| if OK_Next_Tok then |
| return True; |
| end if; |
| end; |
| end if; |
| end; |
| end if; |
| |
| -- If we fall through it is not a reserved identifier |
| |
| return False; |
| end Is_Reserved_Identifier; |
| |
| ---------------------- |
| -- Merge_Identifier -- |
| ---------------------- |
| |
| procedure Merge_Identifier (Prev : Node_Id; Nxt : Token_Type) is |
| begin |
| if Token /= Tok_Identifier then |
| return; |
| end if; |
| |
| declare |
| S : Saved_Scan_State; |
| T : Token_Type; |
| |
| begin |
| Save_Scan_State (S); |
| Scan; |
| T := Token; |
| Restore_Scan_State (S); |
| |
| if T /= Nxt then |
| return; |
| end if; |
| end; |
| |
| -- Check exactly one space between identifiers |
| |
| if Source (Token_Ptr - 1) /= ' ' |
| or else Int (Token_Ptr) /= |
| Int (Prev_Token_Ptr) + Length_Of_Name (Chars (Prev)) + 1 |
| then |
| return; |
| end if; |
| |
| -- Do the merge |
| |
| Get_Name_String (Chars (Token_Node)); |
| |
| declare |
| Buf : constant String (1 .. Name_Len) := |
| Name_Buffer (1 .. Name_Len); |
| |
| begin |
| Get_Name_String (Chars (Prev)); |
| Add_Char_To_Name_Buffer ('_'); |
| Add_Str_To_Name_Buffer (Buf); |
| Set_Chars (Prev, Name_Find); |
| end; |
| |
| Error_Msg_Node_1 := Prev; |
| Error_Msg_SC ("unexpected identifier, possibly & was meant here"); |
| Scan; |
| end Merge_Identifier; |
| |
| ------------------------------- |
| -- Missing_Semicolon_On_When -- |
| ------------------------------- |
| |
| function Missing_Semicolon_On_When return Boolean is |
| State : Saved_Scan_State; |
| |
| begin |
| if not Token_Is_At_Start_Of_Line then |
| return False; |
| |
| elsif Scopes (Scope.Last).Etyp /= E_Case then |
| return False; |
| |
| else |
| Save_Scan_State (State); |
| Scan; -- past WHEN |
| Scan; -- past token after WHEN |
| |
| if Token = Tok_Arrow then |
| Restore_Scan_State (State); |
| return True; |
| else |
| Restore_Scan_State (State); |
| return False; |
| end if; |
| end if; |
| end Missing_Semicolon_On_When; |
| |
| ------------------- |
| -- Next_Token_Is -- |
| ------------------- |
| |
| function Next_Token_Is (Tok : Token_Type) return Boolean is |
| Scan_State : Saved_Scan_State; |
| Result : Boolean; |
| begin |
| Save_Scan_State (Scan_State); |
| Scan; |
| Result := (Token = Tok); |
| Restore_Scan_State (Scan_State); |
| return Result; |
| end Next_Token_Is; |
| |
| ------------------- |
| -- No_Constraint -- |
| ------------------- |
| |
| procedure No_Constraint is |
| begin |
| -- If we have a token that could start a constraint on the same line |
| -- then cnsider this an illegal constraint. It seems unlikely it could |
| -- be anything else if it is on the same line. |
| |
| if Token in Token_Class_Consk then |
| Error_Msg_SC ("constraint not allowed here"); |
| Discard_Junk_Node (P_Constraint_Opt); |
| end if; |
| end No_Constraint; |
| |
| --------------------- |
| -- Pop_Scope_Stack -- |
| --------------------- |
| |
| procedure Pop_Scope_Stack is |
| begin |
| pragma Assert (Scope.Last > 0); |
| Scope.Decrement_Last; |
| |
| if Include_Subprogram_In_Messages |
| and then Scopes (Scope.Last).Labl /= Error |
| then |
| Current_Node := Scopes (Scope.Last).Labl; |
| end if; |
| |
| if Debug_Flag_P then |
| Error_Msg_Uint_1 := UI_From_Int (Scope.Last); |
| Error_Msg_SC ("decrement scope stack ptr, new value = ^!"); |
| end if; |
| end Pop_Scope_Stack; |
| |
| ---------------------- |
| -- Push_Scope_Stack -- |
| ---------------------- |
| |
| procedure Push_Scope_Stack is |
| begin |
| Scope.Increment_Last; |
| |
| if Style_Check_Max_Nesting_Level |
| and then Scope.Last = Style_Max_Nesting_Level + 1 |
| then |
| Error_Msg |
| ("(style) maximum nesting level exceeded", |
| First_Non_Blank_Location); |
| end if; |
| |
| Scopes (Scope.Last).Junk := False; |
| Scopes (Scope.Last).Node := Empty; |
| |
| if Debug_Flag_P then |
| Error_Msg_Uint_1 := UI_From_Int (Scope.Last); |
| Error_Msg_SC ("increment scope stack ptr, new value = ^!"); |
| end if; |
| end Push_Scope_Stack; |
| |
| ---------------------- |
| -- Separate_Present -- |
| ---------------------- |
| |
| function Separate_Present return Boolean is |
| Scan_State : Saved_Scan_State; |
| |
| begin |
| if Token = Tok_Separate then |
| return True; |
| |
| elsif Token /= Tok_Identifier then |
| return False; |
| |
| else |
| Save_Scan_State (Scan_State); |
| Scan; -- past identifier |
| |
| if Token = Tok_Semicolon then |
| Restore_Scan_State (Scan_State); |
| return Bad_Spelling_Of (Tok_Separate); |
| |
| else |
| Restore_Scan_State (Scan_State); |
| return False; |
| end if; |
| end if; |
| end Separate_Present; |
| |
| -------------------------- |
| -- Signal_Bad_Attribute -- |
| -------------------------- |
| |
| procedure Signal_Bad_Attribute is |
| begin |
| Bad_Attribute (Token_Node, Token_Name, Warn => False); |
| end Signal_Bad_Attribute; |
| |
| ----------------------------- |
| -- Token_Is_At_End_Of_Line -- |
| ----------------------------- |
| |
| function Token_Is_At_End_Of_Line return Boolean is |
| S : Source_Ptr; |
| |
| begin |
| -- Skip past blanks and horizontal tabs |
| |
| S := Scan_Ptr; |
| while Source (S) = ' ' or else Source (S) = ASCII.HT loop |
| S := S + 1; |
| end loop; |
| |
| -- We are at end of line if at a control character (CR/LF/VT/FF/EOF) |
| -- or if we are at the start of an end of line comment sequence. |
| |
| return Source (S) < ' ' |
| or else (Source (S) = '-' and then Source (S + 1) = '-'); |
| end Token_Is_At_End_Of_Line; |
| |
| ------------------------------- |
| -- Token_Is_At_Start_Of_Line -- |
| ------------------------------- |
| |
| function Token_Is_At_Start_Of_Line return Boolean is |
| begin |
| return Token_Ptr = First_Non_Blank_Location or else Token = Tok_EOF; |
| end Token_Is_At_Start_Of_Line; |
| |
| ----------------------------------- |
| -- Warn_If_Standard_Redefinition -- |
| ----------------------------------- |
| |
| procedure Warn_If_Standard_Redefinition (N : Node_Id) is |
| begin |
| if Warn_On_Standard_Redefinition then |
| declare |
| C : constant Entity_Id := Current_Entity (N); |
| begin |
| if Present (C) and then Sloc (C) = Standard_Location then |
| Error_Msg_N ("redefinition of entity& in Standard?.k?", N); |
| end if; |
| end; |
| end if; |
| end Warn_If_Standard_Redefinition; |
| |
| end Util; |