Commit d82d3baa by Thomas Quinot Committed by Arnaud Charlet

sinput-l.adb (Load_File): Disable style checks when preprocessing.

2007-12-06  Thomas Quinot  <quinot@adacore.com>

	* sinput-l.adb (Load_File): Disable style checks when preprocessing.

From-SVN: r130861
parent 968d9db3
...@@ -73,8 +73,7 @@ package body Sinput.L is ...@@ -73,8 +73,7 @@ package body Sinput.L is
-- Used to initialize the preprocessor. -- Used to initialize the preprocessor.
procedure New_EOL_In_Prep_Buffer; procedure New_EOL_In_Prep_Buffer;
-- Add an LF to Prep_Buffer. -- Add an LF to Prep_Buffer (used to initialize the preprocessor)
-- Used to initialize the preprocessor.
function Load_File function Load_File
(N : File_Name_Type; (N : File_Name_Type;
...@@ -90,10 +89,10 @@ package body Sinput.L is ...@@ -90,10 +89,10 @@ package body Sinput.L is
Loc : constant Source_Ptr := Sloc (N); Loc : constant Source_Ptr := Sloc (N);
begin begin
-- We only do the adjustment if the value is between the appropriate -- We only do the adjustment if the value is between the appropriate low
-- low and high values. It is not clear that this should ever not be -- and high values. It is not clear that this should ever not be the
-- the case, but in practice there seem to be some nodes that get -- case, but in practice there seem to be some nodes that get copied
-- copied twice, and this is a defence against that happening. -- twice, and this is a defence against that happening.
if A.Lo <= Loc and then Loc <= A.Hi then if A.Lo <= Loc and then Loc <= A.Hi then
Set_Sloc (N, Loc + A.Adjust); Set_Sloc (N, Loc + A.Adjust);
...@@ -232,19 +231,19 @@ package body Sinput.L is ...@@ -232,19 +231,19 @@ package body Sinput.L is
Write_Eol; Write_Eol;
end if; end if;
-- For a given character in the source, a higher subscript will be -- For a given character in the source, a higher subscript will be used
-- used to access the instantiation, which means that the virtual -- to access the instantiation, which means that the virtual origin must
-- origin must have a corresponding lower value. We compute this -- have a corresponding lower value. We compute this new origin by
-- new origin by taking the address of the appropriate adjusted -- taking the address of the appropriate adjusted element in the old
-- element in the old array. Since this adjusted element will be -- array. Since this adjusted element will be at a negative subscript,
-- at a negative subscript, we must suppress checks. -- we must suppress checks.
declare declare
pragma Suppress (All_Checks); pragma Suppress (All_Checks);
pragma Warnings (Off); pragma Warnings (Off);
-- This unchecked conversion is aliasing safe, since it is never -- This unchecked conversion is aliasing safe, since it is never used
-- used to create improperly aliased pointer values. -- to create improperly aliased pointer values.
function To_Source_Buffer_Ptr is new function To_Source_Buffer_Ptr is new
Unchecked_Conversion (Address, Source_Buffer_Ptr); Unchecked_Conversion (Address, Source_Buffer_Ptr);
...@@ -472,6 +471,10 @@ package body Sinput.L is ...@@ -472,6 +471,10 @@ package body Sinput.L is
T : constant Nat := Total_Errors_Detected; T : constant Nat := Total_Errors_Detected;
-- Used to check if there were errors during preprocessing -- Used to check if there were errors during preprocessing
Save_Style_Check : Boolean;
-- Saved state of the Style_Check flag (which needs to be
-- temporarily set to False during preprocessing, see below).
begin begin
-- If this is the first time we preprocess a source, allocate -- If this is the first time we preprocess a source, allocate
-- the preprocessing buffer. -- the preprocessing buffer.
...@@ -494,25 +497,33 @@ package body Sinput.L is ...@@ -494,25 +497,33 @@ package body Sinput.L is
Put_Char => Put_Char_In_Prep_Buffer'Access, Put_Char => Put_Char_In_Prep_Buffer'Access,
New_EOL => New_EOL_In_Prep_Buffer'Access); New_EOL => New_EOL_In_Prep_Buffer'Access);
-- Initialize the scanner and set its behavior for -- Initialize scanner and set its behavior for preprocessing,
-- preprocessing, then preprocess. -- then preprocess. Also disable style checks, since some of
-- them are done in the scanner (specifically, those dealing
-- with line length and line termination), and cannot be done
-- during preprocessing (because the source file index table
-- has not been set yet).
Scn.Scanner.Initialize_Scanner (X); Scn.Scanner.Initialize_Scanner (X);
Scn.Scanner.Set_Special_Character ('#'); Scn.Scanner.Set_Special_Character ('#');
Scn.Scanner.Set_Special_Character ('$'); Scn.Scanner.Set_Special_Character ('$');
Scn.Scanner.Set_End_Of_Line_As_Token (True); Scn.Scanner.Set_End_Of_Line_As_Token (True);
Save_Style_Check := Opt.Style_Check;
Opt.Style_Check := False;
Preprocess; Preprocess;
-- Reset the scanner to its standard behavior -- Reset the scanner to its standard behavior, and restore the
-- Style_Checks flag.
Scn.Scanner.Reset_Special_Characters; Scn.Scanner.Reset_Special_Characters;
Scn.Scanner.Set_End_Of_Line_As_Token (False); Scn.Scanner.Set_End_Of_Line_As_Token (False);
Opt.Style_Check := Save_Style_Check;
-- If there were errors during preprocessing, record an -- If there were errors during preprocessing, record an error
-- error at the start of the file, and do not change the -- at the start of the file, and do not change the source
-- source buffer. -- buffer.
if T /= Total_Errors_Detected then if T /= Total_Errors_Detected then
Errout.Error_Msg Errout.Error_Msg
...@@ -531,12 +542,11 @@ package body Sinput.L is ...@@ -531,12 +542,11 @@ package body Sinput.L is
-- Physical buffer allocated -- Physical buffer allocated
type Actual_Source_Ptr is access Actual_Source_Buffer; type Actual_Source_Ptr is access Actual_Source_Buffer;
-- This is the pointer type for the physical buffer -- Pointer type for the physical buffer allocated
-- allocated.
Actual_Ptr : constant Actual_Source_Ptr := Actual_Ptr : constant Actual_Source_Ptr :=
new Actual_Source_Buffer; new Actual_Source_Buffer;
-- And this is the actual physical buffer -- Actual physical buffer
begin begin
Actual_Ptr (Lo .. Hi - 1) := Actual_Ptr (Lo .. Hi - 1) :=
...@@ -544,9 +554,9 @@ package body Sinput.L is ...@@ -544,9 +554,9 @@ package body Sinput.L is
Actual_Ptr (Hi) := EOF; Actual_Ptr (Hi) := EOF;
-- Now we need to work out the proper virtual origin -- Now we need to work out the proper virtual origin
-- pointer to return. This is exactly -- pointer to return. This is Actual_Ptr (0)'Address, but
-- Actual_Ptr (0)'Address, but we have to be careful to -- we have to be careful to suppress checks to compute
-- suppress checks to compute this address. -- this address.
declare declare
pragma Suppress (All_Checks); pragma Suppress (All_Checks);
...@@ -679,11 +689,10 @@ package body Sinput.L is ...@@ -679,11 +689,10 @@ package body Sinput.L is
begin begin
Initialize_Scanner (No_Unit, X); Initialize_Scanner (No_Unit, X);
-- We scan past junk to the first interesting compilation unit -- We scan past junk to the first interesting compilation unit token, to
-- token, to see if it is SEPARATE. We ignore WITH keywords during -- see if it is SEPARATE. We ignore WITH keywords during this and also
-- this and also PRIVATE. The reason for ignoring PRIVATE is that -- PRIVATE. The reason for ignoring PRIVATE is that it handles some
-- it handles some error situations, and also to handle PRIVATE WITH -- error situations, and also to handle PRIVATE WITH in Ada 2005 mode.
-- in Ada 2005 mode.
while Token = Tok_With while Token = Tok_With
or else Token = Tok_Private or else Token = Tok_Private
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment