@@ -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
From: Steve Baird <baird@adacore.com> 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. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/scng.adb | 183 +++++++++++++++++++++++++++++++---------------- 1 file changed, 122 insertions(+), 61 deletions(-)