diff options
author | Steve Baird <baird@adacore.com> | 2024-03-13 17:46:56 -0700 |
---|---|---|
committer | Marc Poulhiès <poulhies@adacore.com> | 2024-05-17 10:21:06 +0200 |
commit | 15b5a95d36a3c8cc35189aa951bdcdbf59ad4160 (patch) | |
tree | 0fa1309630b889aa7abbf00fe9e77405186b9c9c | |
parent | 22928da141a8bbee9994fbae00c595877ed060ad (diff) | |
download | gcc-15b5a95d36a3c8cc35189aa951bdcdbf59ad4160.zip gcc-15b5a95d36a3c8cc35189aa951bdcdbf59ad4160.tar.gz gcc-15b5a95d36a3c8cc35189aa951bdcdbf59ad4160.tar.bz2 |
ada: Improve test for unprocessed preprocessor directives
Preprocessor directives are case insensitive and may have spaces or tabs
between the '#' and the keyword. When checking for the error case of
unprocessed preprocessor directives, take these rules into account.
gcc/ada/
* scng.adb (scan): When checking for an unprocessed preprocessor
directive, take into account the preprocessor's rules about case
insensitivity and about white space between the '#' and the
keyword.
-rw-r--r-- | gcc/ada/scng.adb | 183 |
1 files changed, 122 insertions, 61 deletions
diff --git a/gcc/ada/scng.adb b/gcc/ada/scng.adb index 9b1d00e..8b2829f 100644 --- a/gcc/ada/scng.adb +++ b/gcc/ada/scng.adb @@ -40,6 +40,7 @@ with Widechar; use Widechar; pragma Warnings (Off); -- This package is used also by gnatcoll +with System.Case_Util; with System.CRC32; with System.UTF_32; use System.UTF_32; with System.WCh_Con; use System.WCh_Con; @@ -2250,86 +2251,146 @@ package body Scng is when Special_Preprocessor_Character => - -- If Set_Special_Character has been called for this character, - -- set Scans.Special_Character and return a Special token. + declare + function Matches_After_Skipping_White_Space + (S : String) return Boolean; + + -- Return True iff after skipping past white space the + -- next Source characters match the given string. + + ---------------------------------------- + -- Matches_After_Skipping_White_Space -- + ---------------------------------------- + + function Matches_After_Skipping_White_Space + (S : String) return Boolean + is + function To_Lower_Case_String (Buff : Text_Buffer) + return String; + -- Convert a text buffer to a lower-case string. + + -------------------------- + -- To_Lower_Case_String -- + -------------------------- + + function To_Lower_Case_String (Buff : Text_Buffer) + return String + is + subtype One_Based is Text_Buffer (1 .. Buff'Length); + Result : String := String (One_Based (Buff)); + begin + -- The System.Case_Util.To_Lower function (the overload + -- that takes a string parameter) cannot be called + -- here due to bootstrapping problems. That function + -- was added too recently. + + System.Case_Util.To_Lower (Result); + return Result; + end To_Lower_Case_String; + + pragma Assert (Source (Scan_Ptr) = '#'); + Local_Scan_Ptr : Source_Ptr := Scan_Ptr + 1; + + -- Start of processing for Matches_After_Skipping_White_Space - if Special_Characters (Source (Scan_Ptr)) then - Token_Ptr := Scan_Ptr; - Token := Tok_Special; - Special_Character := Source (Scan_Ptr); - Scan_Ptr := Scan_Ptr + 1; - return; + begin + while Local_Scan_Ptr in Source'Range + and then Source (Local_Scan_Ptr) in ' ' | HT + loop + Local_Scan_Ptr := Local_Scan_Ptr + 1; + end loop; - -- Check for something looking like a preprocessor directive + return Local_Scan_Ptr in Source'Range + and then Local_Scan_Ptr + (S'Length - 1) in Source'Range + and then S = To_Lower_Case_String ( + Source (Local_Scan_Ptr .. + Local_Scan_Ptr + (S'Length - 1))); + end Matches_After_Skipping_White_Space; - elsif Source (Scan_Ptr) = '#' - and then (Source (Scan_Ptr + 1 .. Scan_Ptr + 2) = "if" - or else - Source (Scan_Ptr + 1 .. Scan_Ptr + 5) = "elsif" - or else - Source (Scan_Ptr + 1 .. Scan_Ptr + 4) = "else" - or else - Source (Scan_Ptr + 1 .. Scan_Ptr + 3) = "end") - then - Error_Msg_S - ("preprocessor directive ignored, preprocessor not active"); + begin + -- If Set_Special_Character has been called for this character, + -- set Scans.Special_Character and return a Special token. - -- Skip to end of line + if Special_Characters (Source (Scan_Ptr)) then + Token_Ptr := Scan_Ptr; + Token := Tok_Special; + Special_Character := Source (Scan_Ptr); + Scan_Ptr := Scan_Ptr + 1; + return; - loop - if Source (Scan_Ptr) in Graphic_Character - or else - Source (Scan_Ptr) = HT - then - Scan_Ptr := Scan_Ptr + 1; + -- Check for something looking like a preprocessor directive + + elsif Source (Scan_Ptr) = '#' + and then (Matches_After_Skipping_White_Space ("if") + or else + Matches_After_Skipping_White_Space ("elsif") + or else + Matches_After_Skipping_White_Space ("else") + or else + Matches_After_Skipping_White_Space ("end")) + then + Error_Msg_S + ("preprocessor directive ignored" & + ", preprocessor not active"); - -- Done if line terminator or EOF + -- Skip to end of line - elsif Source (Scan_Ptr) in Line_Terminator + loop + if Source (Scan_Ptr) in Graphic_Character or else - Source (Scan_Ptr) = EOF - then - exit; + Source (Scan_Ptr) = HT + then + Scan_Ptr := Scan_Ptr + 1; - -- If we have a wide character, we have to scan it out, - -- because it might be a legitimate line terminator + -- Done if line terminator or EOF - elsif Start_Of_Wide_Character then - declare - Wptr : constant Source_Ptr := Scan_Ptr; - Code : Char_Code; - Err : Boolean; + elsif Source (Scan_Ptr) in Line_Terminator + or else + Source (Scan_Ptr) = EOF + then + exit; - begin - Scan_Wide (Source, Scan_Ptr, Code, Err); + -- If we have a wide character, we have to scan it out, + -- because it might be a legitimate line terminator - -- If not well formed wide character, then just skip - -- past it and ignore it. + elsif Start_Of_Wide_Character then + declare + Wptr : constant Source_Ptr := Scan_Ptr; + Code : Char_Code; + Err : Boolean; - if Err then - Scan_Ptr := Wptr + 1; + begin + Scan_Wide (Source, Scan_Ptr, Code, Err); - -- If UTF_32 terminator, terminate comment scan + -- If not well formed wide character, then just + -- skip past it and ignore it. - elsif Is_UTF_32_Line_Terminator (UTF_32 (Code)) then - Scan_Ptr := Wptr; - exit; - end if; - end; + if Err then + Scan_Ptr := Wptr + 1; - -- Else keep going (don't worry about bad comment chars - -- in this context, we just want to find the end of line. + -- If UTF_32 terminator, terminate comment scan - else - Scan_Ptr := Scan_Ptr + 1; - end if; - end loop; + elsif Is_UTF_32_Line_Terminator (UTF_32 (Code)) then + Scan_Ptr := Wptr; + exit; + end if; + end; - -- Otherwise, this is an illegal character + -- Else keep going (don't worry about bad comment chars + -- in this context, we just want to find the end of line. - else - Error_Illegal_Character; - end if; + else + Scan_Ptr := Scan_Ptr + 1; + end if; + end loop; + + -- Otherwise, this is an illegal character + + else + Error_Illegal_Character; + end if; + + end; -- End switch on non-blank character |