-- --
-- B o d y --
-- --
--- $Revision: 1.40 $
--- --
--- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2008, 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 2, or (at your option) any later ver- --
+-- 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 COPYING. If not, write --
--- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
--- MA 02111-1307, USA. --
+-- 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. --
--- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
with Alloc;
-with Atree; use Atree;
-with Debug; use Debug;
-with Einfo; use Einfo;
-with Namet; use Namet;
-with Opt;
-with Osint; use Osint;
-with Output; use Output;
-with Scans; use Scans;
-with Scn; use Scn;
-with Sinfo; use Sinfo;
-with System; use System;
+with Atree; use Atree;
+with Debug; use Debug;
+with Einfo; use Einfo;
+with Errout; use Errout;
+with Fname; use Fname;
+with Hostparm;
+with Opt; use Opt;
+with Osint; use Osint;
+with Output; use Output;
+with Prep; use Prep;
+with Prepcomp; use Prepcomp;
+with Scans; use Scans;
+with Scn; use Scn;
+with Sinfo; use Sinfo;
+with Snames; use Snames;
+with System; use System;
+
+with System.OS_Lib; use System.OS_Lib;
with Unchecked_Conversion;
package body Sinput.L is
- Dfile : Source_File_Index;
- -- Index of currently active debug source file
+ Prep_Buffer : Text_Buffer_Ptr := null;
+ -- A buffer to temporarily stored the result of preprocessing a source.
+ -- It is only allocated if there is at least one source to preprocess.
+
+ Prep_Buffer_Last : Text_Ptr := 0;
+ -- Index of the last significant character in Prep_Buffer
+
+ Initial_Size_Of_Prep_Buffer : constant := 10_000;
+ -- Size of Prep_Buffer when it is first allocated
+
+ -- When a file is to be preprocessed and the options to list symbols
+ -- has been selected (switch -s), Prep.List_Symbols is called with a
+ -- "foreword", a single line indicating what source the symbols apply to.
+ -- The following two constant String are the start and the end of this
+ -- foreword.
+
+ Foreword_Start : constant String :=
+ "Preprocessing Symbols for source """;
+
+ Foreword_End : constant String := """";
-----------------
-- Subprograms --
-----------------
- procedure Trim_Lines_Table (S : Source_File_Index);
- -- Set lines table size for entry S in the source file table to
- -- correspond to the current value of Num_Source_Lines, releasing
- -- any unused storage.
+ procedure Put_Char_In_Prep_Buffer (C : Character);
+ -- Add one character in Prep_Buffer, extending Prep_Buffer if need be.
+ -- Used to initialize the preprocessor.
+
+ procedure New_EOL_In_Prep_Buffer;
+ -- Add an LF to Prep_Buffer (used to initialize the preprocessor)
function Load_File
- (N : File_Name_Type;
- T : File_Type)
- return Source_File_Index;
- -- Load a source file or a configuration pragma file.
+ (N : File_Name_Type;
+ T : Osint.File_Type) return Source_File_Index;
+ -- Load a source file, a configuration pragmas file or a definition file
+ -- Coding also allows preprocessing file, but not a library file ???
-------------------------------
-- Adjust_Instantiation_Sloc --
Loc : constant Source_Ptr := Sloc (N);
begin
- -- We only do the adjustment if the value is between the appropriate
- -- low and high values. It is not clear that this should ever not be
- -- the case, but in practice there seem to be some nodes that get
- -- copied twice, and this is a defence against that happening.
+ -- We only do the adjustment if the value is between the appropriate low
+ -- and high values. It is not clear that this should ever not be the
+ -- case, but in practice there seem to be some nodes that get copied
+ -- twice, and this is a defence against that happening.
if A.Lo <= Loc and then Loc <= A.Hi then
Set_Sloc (N, Loc + A.Adjust);
end if;
end Adjust_Instantiation_Sloc;
- ------------------------
- -- Close_Debug_Source --
- ------------------------
-
- procedure Close_Debug_Source is
- S : Source_File_Record renames Source_File.Table (Dfile);
- Src : Source_Buffer_Ptr;
-
- begin
- Trim_Lines_Table (Dfile);
- Close_Debug_File;
-
- -- Now we need to read the file that we wrote and store it
- -- in memory for subsequent access.
-
- Read_Source_File
- (S.Debug_Source_Name, S.Source_First, S.Source_Last, Src);
- S.Source_Text := Src;
- end Close_Debug_Source;
-
--------------------------------
-- Complete_Source_File_Entry --
--------------------------------
Source_File.Table (CSF).Source_Checksum := Checksum;
end Complete_Source_File_Entry;
- -------------------------
- -- Create_Debug_Source --
- -------------------------
-
- procedure Create_Debug_Source
- (Source : Source_File_Index;
- Loc : out Source_Ptr)
- is
- begin
- Loc := Source_File.Table (Source_File.Last).Source_Last + 1;
- Source_File.Increment_Last;
- Dfile := Source_File.Last;
-
- declare
- S : Source_File_Record renames Source_File.Table (Dfile);
-
- begin
- S := Source_File.Table (Source);
- S.Debug_Source_Name := Create_Debug_File (S.File_Name);
- S.Source_First := Loc;
- S.Source_Last := Loc;
- S.Lines_Table := null;
- S.Last_Source_Line := 1;
-
- -- Allocate lines table, guess that it needs to be three times
- -- bigger than the original source (in number of lines).
-
- Alloc_Line_Tables
- (S, Int (Source_File.Table (Source).Last_Source_Line * 3));
- S.Lines_Table (1) := Loc;
- end;
-
- if Debug_Flag_GG then
- Write_Str ("---> Create_Debug_Source (Source => ");
- Write_Int (Int (Source));
- Write_Str (", Loc => ");
- Write_Int (Int (Loc));
- Write_Str (");");
- Write_Eol;
- end if;
-
- end Create_Debug_Source;
-
---------------------------------
-- Create_Instantiation_Source --
---------------------------------
procedure Create_Instantiation_Source
- (Inst_Node : Entity_Id;
- Template_Id : Entity_Id;
- A : out Sloc_Adjustment)
+ (Inst_Node : Entity_Id;
+ Template_Id : Entity_Id;
+ Inlined_Body : Boolean;
+ A : out Sloc_Adjustment)
is
Dnod : constant Node_Id := Declaration_Node (Template_Id);
Xold : Source_File_Index;
A.Lo := Source_File.Table (Xold).Source_First;
A.Hi := Source_File.Table (Xold).Source_Last;
- Source_File.Increment_Last;
+ Source_File.Append (Source_File.Table (Xold));
Xnew := Source_File.Last;
- Source_File.Table (Xnew) := Source_File.Table (Xold);
+ Source_File.Table (Xnew).Inlined_Body := Inlined_Body;
Source_File.Table (Xnew).Instantiation := Sloc (Inst_Node);
Source_File.Table (Xnew).Template := Xold;
Source_File.Table (Xnew).Source_First :=
Source_File.Table (Xnew - 1).Source_Last + 1;
-
A.Adjust := Source_File.Table (Xnew).Source_First - A.Lo;
Source_File.Table (Xnew).Source_Last := A.Hi + A.Adjust;
+ Set_Source_File_Index_Table (Xnew);
+
Source_File.Table (Xnew).Sloc_Adjust :=
Source_File.Table (Xold).Sloc_Adjust - A.Adjust;
Write_Eol;
end if;
- -- For a given character in the source, a higher subscript will be
- -- used to access the instantiation, which means that the virtual
- -- origin must have a corresponding lower value. We compute this
- -- new origin by taking the address of the appropriate adjusted
- -- element in the old array. Since this adjusted element will be
- -- at a negative subscript, we must suppress checks.
+ -- For a given character in the source, a higher subscript will be used
+ -- to access the instantiation, which means that the virtual origin must
+ -- have a corresponding lower value. We compute this new origin by
+ -- taking the address of the appropriate adjusted element in the old
+ -- array. Since this adjusted element will be at a negative subscript,
+ -- we must suppress checks.
declare
pragma Suppress (All_Checks);
+ pragma Warnings (Off);
+ -- This unchecked conversion is aliasing safe, since it is never used
+ -- to create improperly aliased pointer values.
+
function To_Source_Buffer_Ptr is new
Unchecked_Conversion (Address, Source_Buffer_Ptr);
+ pragma Warnings (On);
+
begin
Source_File.Table (Xnew).Source_Text :=
To_Source_Buffer_Ptr
(Source_File.Table (Xold).Source_Text (-A.Adjust)'Address);
end;
-
end Create_Instantiation_Source;
----------------------
----------------------
function Load_Config_File
- (N : File_Name_Type)
- return Source_File_Index
+ (N : File_Name_Type) return Source_File_Index
is
begin
return Load_File (N, Osint.Config);
end Load_Config_File;
+ --------------------------
+ -- Load_Definition_File --
+ --------------------------
+
+ function Load_Definition_File
+ (N : File_Name_Type) return Source_File_Index
+ is
+ begin
+ return Load_File (N, Osint.Definition);
+ end Load_Definition_File;
+
---------------
-- Load_File --
---------------
function Load_File
- (N : File_Name_Type;
- T : File_Type)
- return Source_File_Index
+ (N : File_Name_Type;
+ T : Osint.File_Type) return Source_File_Index
is
- Src : Source_Buffer_Ptr;
- X : Source_File_Index;
- Lo : Source_Ptr;
- Hi : Source_Ptr;
+ Src : Source_Buffer_Ptr;
+ X : Source_File_Index;
+ Lo : Source_Ptr;
+ Hi : Source_Ptr;
+
+ Preprocessing_Needed : Boolean := False;
begin
- for J in 1 .. Source_File.Last loop
- if Source_File.Table (J).File_Name = N then
- return J;
- end if;
- end loop;
+ -- If already there, don't need to reload file. An exception occurs
+ -- in multiple unit per file mode. It would be nice in this case to
+ -- share the same source file for each unit, but this leads to many
+ -- difficulties with assumptions (e.g. in the body of lib), that a
+ -- unit can be found by locating its source file index. Since we do
+ -- not expect much use of this mode, it's no big deal to waste a bit
+ -- of space and time by reading and storing the source multiple times.
+
+ if Multiple_Unit_Index = 0 then
+ for J in 1 .. Source_File.Last loop
+ if Source_File.Table (J).File_Name = N then
+ return J;
+ end if;
+ end loop;
+ end if;
-- Here we must build a new entry in the file table
+ -- But first, we must check if a source needs to be preprocessed,
+ -- because we may have to load and parse a definition file, and we want
+ -- to do that before we load the source, so that the buffer of the
+ -- source will be the last created, and we will be able to replace it
+ -- and modify Hi without stepping on another buffer.
+
+ if T = Osint.Source and then not Is_Internal_File_Name (N) then
+ Prepare_To_Preprocess
+ (Source => N, Preprocessing_Needed => Preprocessing_Needed);
+ end if;
+
Source_File.Increment_Last;
X := Source_File.Last;
Lo := Source_File.Table (X - 1).Source_Last + 1;
end if;
- Read_Source_File (N, Lo, Hi, Src, T);
+ Osint.Read_Source_File (N, Lo, Hi, Src, T);
if Src = null then
Source_File.Decrement_Last;
end if;
declare
- S : Source_File_Record renames Source_File.Table (X);
+ S : Source_File_Record renames Source_File.Table (X);
+ File_Type : Type_Of_File;
begin
- S := (Debug_Source_Name => Full_Source_Name,
+ case T is
+ when Osint.Source =>
+ File_Type := Sinput.Src;
+
+ when Osint.Library =>
+ raise Program_Error;
+
+ when Osint.Config =>
+ File_Type := Sinput.Config;
+
+ when Osint.Definition =>
+ File_Type := Def;
+
+ when Osint.Preprocessing_Data =>
+ File_Type := Preproc;
+ end case;
+
+ S := (Debug_Source_Name => N,
File_Name => N,
+ File_Type => File_Type,
First_Mapped_Line => No_Line_Number,
- Full_File_Name => Full_Source_Name,
- Full_Ref_Name => Full_Source_Name,
+ Full_Debug_Name => Osint.Full_Source_Name,
+ Full_File_Name => Osint.Full_Source_Name,
+ Full_Ref_Name => Osint.Full_Source_Name,
Identifier_Casing => Unknown,
+ Inlined_Body => False,
Instantiation => No_Location,
Keyword_Casing => Unknown,
Last_Source_Line => 1,
Source_Last => Hi,
Source_Text => Src,
Template => No_Source_File,
- Time_Stamp => Current_Source_File_Stamp);
+ Unit => No_Unit,
+ Time_Stamp => Osint.Current_Source_File_Stamp);
Alloc_Line_Tables (S, Opt.Table_Factor * Alloc.Lines_Initial);
S.Lines_Table (1) := Lo;
end;
+ -- Preprocess the source if it needs to be preprocessed
+
+ if Preprocessing_Needed then
+ if Opt.List_Preprocessing_Symbols then
+ Get_Name_String (N);
+
+ declare
+ Foreword : String (1 .. Foreword_Start'Length +
+ Name_Len + Foreword_End'Length);
+
+ begin
+ Foreword (1 .. Foreword_Start'Length) := Foreword_Start;
+ Foreword (Foreword_Start'Length + 1 ..
+ Foreword_Start'Length + Name_Len) :=
+ Name_Buffer (1 .. Name_Len);
+ Foreword (Foreword'Last - Foreword_End'Length + 1 ..
+ Foreword'Last) := Foreword_End;
+ Prep.List_Symbols (Foreword);
+ end;
+ end if;
+
+ declare
+ T : constant Nat := Total_Errors_Detected;
+ -- 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).
+
+ Modified : Boolean;
+
+ begin
+ -- If this is the first time we preprocess a source, allocate
+ -- the preprocessing buffer.
+
+ if Prep_Buffer = null then
+ Prep_Buffer :=
+ new Text_Buffer (1 .. Initial_Size_Of_Prep_Buffer);
+ end if;
+
+ -- Make sure the preprocessing buffer is empty
+
+ Prep_Buffer_Last := 0;
+
+ -- Initialize the preprocessor
+
+ Prep.Initialize
+ (Error_Msg => Errout.Error_Msg'Access,
+ Scan => Scn.Scanner.Scan'Access,
+ Set_Ignore_Errors => Errout.Set_Ignore_Errors'Access,
+ Put_Char => Put_Char_In_Prep_Buffer'Access,
+ New_EOL => New_EOL_In_Prep_Buffer'Access);
+
+ -- Initialize scanner and set its behavior for preprocessing,
+ -- 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.Set_Special_Character ('#');
+ Scn.Scanner.Set_Special_Character ('$');
+ Scn.Scanner.Set_End_Of_Line_As_Token (True);
+ Save_Style_Check := Opt.Style_Check;
+ Opt.Style_Check := False;
+
+ Preprocess (Modified);
+
+ -- Reset the scanner to its standard behavior, and restore the
+ -- Style_Checks flag.
+
+ Scn.Scanner.Reset_Special_Characters;
+ Scn.Scanner.Set_End_Of_Line_As_Token (False);
+ Opt.Style_Check := Save_Style_Check;
+
+ -- If there were errors during preprocessing, record an error
+ -- at the start of the file, and do not change the source
+ -- buffer.
+
+ if T /= Total_Errors_Detected then
+ Errout.Error_Msg
+ ("file could not be successfully preprocessed", Lo);
+ return No_Source_File;
+
+ else
+ -- Output the result of the preprocessing, if requested and
+ -- the source has been modified by the preprocessing.
+
+ if Generate_Processed_File and then Modified then
+ declare
+ FD : File_Descriptor;
+ NB : Integer;
+ Status : Boolean;
+
+ begin
+ Get_Name_String (N);
+
+ if Hostparm.OpenVMS then
+ Add_Str_To_Name_Buffer ("_prep");
+ else
+ Add_Str_To_Name_Buffer (".prep");
+ end if;
+
+ Delete_File (Name_Buffer (1 .. Name_Len), Status);
+
+ FD :=
+ Create_New_File (Name_Buffer (1 .. Name_Len), Text);
+
+ Status := FD /= Invalid_FD;
+
+ if Status then
+ NB :=
+ Write
+ (FD,
+ Prep_Buffer (1)'Address,
+ Integer (Prep_Buffer_Last));
+ Status := NB = Integer (Prep_Buffer_Last);
+ end if;
+
+ if Status then
+ Close (FD, Status);
+ end if;
+
+ if not Status then
+ Errout.Error_Msg
+ ("could not write processed file """ &
+ Name_Buffer (1 .. Name_Len) & '"',
+ Lo);
+ return No_Source_File;
+ end if;
+ end;
+ end if;
+
+ -- Set the new value of Hi
+
+ Hi := Lo + Source_Ptr (Prep_Buffer_Last);
+
+ -- Create the new source buffer
+
+ declare
+ subtype Actual_Source_Buffer is Source_Buffer (Lo .. Hi);
+ -- Physical buffer allocated
+
+ type Actual_Source_Ptr is access Actual_Source_Buffer;
+ -- Pointer type for the physical buffer allocated
+
+ Actual_Ptr : constant Actual_Source_Ptr :=
+ new Actual_Source_Buffer;
+ -- Actual physical buffer
+
+ begin
+ Actual_Ptr (Lo .. Hi - 1) :=
+ Prep_Buffer (1 .. Prep_Buffer_Last);
+ Actual_Ptr (Hi) := EOF;
+
+ -- Now we need to work out the proper virtual origin
+ -- pointer to return. This is Actual_Ptr (0)'Address, but
+ -- we have to be careful to suppress checks to compute
+ -- this address.
+
+ declare
+ pragma Suppress (All_Checks);
+
+ pragma Warnings (Off);
+ -- This unchecked conversion is aliasing safe, since
+ -- it is never used to create improperly aliased
+ -- pointer values.
+
+ function To_Source_Buffer_Ptr is new
+ Unchecked_Conversion (Address, Source_Buffer_Ptr);
+
+ pragma Warnings (On);
+
+ begin
+ Src := To_Source_Buffer_Ptr (Actual_Ptr (0)'Address);
+
+ -- Record in the table the new source buffer and the
+ -- new value of Hi.
+
+ Source_File.Table (X).Source_Text := Src;
+ Source_File.Table (X).Source_Last := Hi;
+
+ -- Reset Last_Line to 1, because the lines do not
+ -- have necessarily the same starts and lengths.
+
+ Source_File.Table (X).Last_Source_Line := 1;
+ end;
+ end;
+ end if;
+ end;
+ end if;
+
+ Set_Source_File_Index_Table (X);
return X;
end if;
end Load_File;
+ ----------------------------------
+ -- Load_Preprocessing_Data_File --
+ ----------------------------------
+
+ function Load_Preprocessing_Data_File
+ (N : File_Name_Type) return Source_File_Index
+ is
+ begin
+ return Load_File (N, Osint.Preprocessing_Data);
+ end Load_Preprocessing_Data_File;
+
----------------------
-- Load_Source_File --
----------------------
function Load_Source_File
- (N : File_Name_Type)
- return Source_File_Index
+ (N : File_Name_Type) return Source_File_Index
is
begin
return Load_File (N, Osint.Source);
end Load_Source_File;
----------------------------
- -- Source_File_Is_Subunit --
+ -- New_EOL_In_Prep_Buffer --
----------------------------
- function Source_File_Is_Subunit (X : Source_File_Index) return Boolean is
+ procedure New_EOL_In_Prep_Buffer is
begin
- Initialize_Scanner (No_Unit, X);
+ Put_Char_In_Prep_Buffer (ASCII.LF);
+ end New_EOL_In_Prep_Buffer;
- -- We scan past junk to the first interesting compilation unit
- -- token, to see if it is SEPARATE. We ignore WITH keywords during
- -- this and also PRIVATE. The reason for ignoring PRIVATE is that
- -- it handles some error situations, and also it is possible that
- -- a PRIVATE WITH feature might be approved some time in the future.
+ -----------------------------
+ -- Put_Char_In_Prep_Buffer --
+ -----------------------------
- while Token = Tok_With
- or else Token = Tok_Private
- or else (Token not in Token_Class_Cunit and then Token /= Tok_EOF)
- loop
- Scan;
- end loop;
-
- return Token = Tok_Separate;
- end Source_File_Is_Subunit;
+ procedure Put_Char_In_Prep_Buffer (C : Character) is
+ begin
+ -- If preprocessing buffer is not large enough, double it
- ----------------------
- -- Trim_Lines_Table --
- ----------------------
+ if Prep_Buffer_Last = Prep_Buffer'Last then
+ declare
+ New_Prep_Buffer : constant Text_Buffer_Ptr :=
+ new Text_Buffer (1 .. 2 * Prep_Buffer_Last);
- procedure Trim_Lines_Table (S : Source_File_Index) is
+ begin
+ New_Prep_Buffer (Prep_Buffer'Range) := Prep_Buffer.all;
+ Free (Prep_Buffer);
+ Prep_Buffer := New_Prep_Buffer;
+ end;
+ end if;
- function realloc
- (P : Lines_Table_Ptr;
- New_Size : Int)
- return Lines_Table_Ptr;
- pragma Import (C, realloc);
+ Prep_Buffer_Last := Prep_Buffer_Last + 1;
+ Prep_Buffer (Prep_Buffer_Last) := C;
+ end Put_Char_In_Prep_Buffer;
- Max : constant Nat := Nat (Source_File.Table (S).Last_Source_Line);
+ -----------------------------------
+ -- Source_File_Is_Pragma_No_Body --
+ -----------------------------------
+ function Source_File_Is_No_Body (X : Source_File_Index) return Boolean is
begin
- -- Release allocated storage that is no longer needed
+ Initialize_Scanner (No_Unit, X);
- Source_File.Table (S).Lines_Table :=
- realloc
- (Source_File.Table (S).Lines_Table,
- Max * (Lines_Table_Type'Component_Size / System.Storage_Unit));
- Source_File.Table (S).Lines_Table_Max := Physical_Line_Number (Max);
- end Trim_Lines_Table;
+ if Token /= Tok_Pragma then
+ return False;
+ end if;
- ----------------------
- -- Write_Debug_Line --
- ----------------------
+ Scan; -- past pragma
- procedure Write_Debug_Line (Str : String; Loc : in out Source_Ptr) is
- S : Source_File_Record renames Source_File.Table (Dfile);
+ if Token /= Tok_Identifier
+ or else Chars (Token_Node) /= Name_No_Body
+ then
+ return False;
+ end if;
- begin
- -- Ignore write request if null line at start of file
+ Scan; -- past No_Body
- if Str'Length = 0 and then Loc = S.Source_First then
- return;
+ if Token /= Tok_Semicolon then
+ return False;
+ end if;
- -- Here we write the line, and update the source record entry
+ Scan; -- past semicolon
- else
- Write_Debug_Info (Str);
- Add_Line_Tables_Entry (S, Loc);
- Loc := Loc + Source_Ptr (Str'Length + Debug_File_Eol_Length);
- S.Source_Last := Loc;
+ return Token = Tok_EOF;
+ end Source_File_Is_No_Body;
- if Debug_Flag_GG then
- declare
- Lin : constant String := Str;
+ ----------------------------
+ -- Source_File_Is_Subunit --
+ ----------------------------
- begin
- Column := 1;
- Write_Str ("---> Write_Debug_Line (Str => """);
- Write_Str (Lin);
- Write_Str (""", Loc => ");
- Write_Int (Int (Loc));
- Write_Str (");");
- Write_Eol;
- end;
- end if;
- end if;
- end Write_Debug_Line;
+ function Source_File_Is_Subunit (X : Source_File_Index) return Boolean is
+ begin
+ Initialize_Scanner (No_Unit, X);
+
+ -- We scan past junk to the first interesting compilation unit token, to
+ -- see if it is SEPARATE. We ignore WITH keywords during this and also
+ -- PRIVATE. The reason for ignoring PRIVATE is that it handles some
+ -- error situations, and also to handle PRIVATE WITH in Ada 2005 mode.
+
+ while Token = Tok_With
+ or else Token = Tok_Private
+ or else (Token not in Token_Class_Cunit and then Token /= Tok_EOF)
+ loop
+ Scan;
+ end loop;
+
+ return Token = Tok_Separate;
+ end Source_File_Is_Subunit;
end Sinput.L;