Mercurial > hg > CbC > CbC_gcc
diff gcc/ada/sinput-l.adb @ 111:04ced10e8804
gcc 7
| author | kono |
|---|---|
| date | Fri, 27 Oct 2017 22:46:09 +0900 |
| parents | |
| children | 84e7813d76e9 |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/gcc/ada/sinput-l.adb Fri Oct 27 22:46:09 2017 +0900 @@ -0,0 +1,915 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- S I N P U T . L -- +-- -- +-- B o d y -- +-- -- +-- Copyright (C) 1992-2017, 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 Alloc; +with Atree; use Atree; +with Debug; use Debug; +with Einfo; use Einfo; +with Errout; use Errout; +with Fname; use Fname; +with Lib; use Lib; +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 Sem_Aux; use Sem_Aux; +with Sem_Util; use Sem_Util; +with Sinfo; use Sinfo; +with Snames; use Snames; +with System; use System; + +with System.OS_Lib; use System.OS_Lib; + +package body Sinput.L is + + 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 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 : 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 -- + ------------------------------- + + procedure Adjust_Instantiation_Sloc + (N : Node_Id; + Factor : Sloc_Adjustment) + is + 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. + + if Loc in Factor.Lo .. Factor.Hi then + Set_Sloc (N, Loc + Factor.Adjust); + end if; + end Adjust_Instantiation_Sloc; + + -------------------------------- + -- Complete_Source_File_Entry -- + -------------------------------- + + procedure Complete_Source_File_Entry is + CSF : constant Source_File_Index := Current_Source_File; + begin + Trim_Lines_Table (CSF); + Source_File.Table (CSF).Source_Checksum := Checksum; + end Complete_Source_File_Entry; + + --------------------------------- + -- Create_Instantiation_Source -- + --------------------------------- + + procedure Create_Instantiation_Source + (Inst_Node : Entity_Id; + Template_Id : Entity_Id; + Factor : out Sloc_Adjustment; + Inlined_Body : Boolean := False; + Inherited_Pragma : Boolean := False) + is + Dnod : constant Node_Id := Declaration_Node (Template_Id); + Xold : Source_File_Index; + Xnew : Source_File_Index; + + begin + Xold := Get_Source_File_Index (Sloc (Template_Id)); + Factor.Lo := Source_File.Table (Xold).Source_First; + Factor.Hi := Source_File.Table (Xold).Source_Last; + + Source_File.Append (Source_File.Table (Xold)); + Xnew := Source_File.Last; + + if Debug_Flag_L then + Write_Eol; + Write_Str ("*** Create_Instantiation_Source: created source "); + Write_Int (Int (Xnew)); + Write_Line (""); + end if; + + declare + Sold : Source_File_Record renames Source_File.Table (Xold); + Snew : Source_File_Record renames Source_File.Table (Xnew); + + Inst_Spec : Node_Id; + + begin + Snew.Index := Xnew; + Snew.Inlined_Body := Inlined_Body; + Snew.Inherited_Pragma := Inherited_Pragma; + Snew.Template := Xold; + + -- For a genuine generic instantiation, assign new instance id. For + -- inlined bodies or inherited pragmas, we retain that of the + -- template, but we save the call location. + + if Inlined_Body or Inherited_Pragma then + Snew.Inlined_Call := Sloc (Inst_Node); + + else + -- If the spec has been instantiated already, and we are now + -- creating the instance source for the corresponding body now, + -- retrieve the instance id that was assigned to the spec, which + -- corresponds to the same instantiation sloc. + + Inst_Spec := Instance_Spec (Inst_Node); + if Present (Inst_Spec) then + declare + Inst_Spec_Ent : Entity_Id; + -- Instance spec entity + + Inst_Spec_Sloc : Source_Ptr; + -- Virtual sloc of the spec instance source + + Inst_Spec_Inst_Id : Instance_Id; + -- Instance id assigned to the instance spec + + begin + Inst_Spec_Ent := Defining_Entity (Inst_Spec); + + -- For a subprogram instantiation, we want the subprogram + -- instance, not the wrapper package. + + if Present (Related_Instance (Inst_Spec_Ent)) then + Inst_Spec_Ent := Related_Instance (Inst_Spec_Ent); + end if; + + -- The specification of the instance entity has a virtual + -- sloc within the instance sloc range. + + -- ??? But the Unit_Declaration_Node has the sloc of the + -- instantiation, which is somewhat of an oddity. + + Inst_Spec_Sloc := + Sloc + (Specification (Unit_Declaration_Node (Inst_Spec_Ent))); + Inst_Spec_Inst_Id := + Source_File.Table + (Get_Source_File_Index (Inst_Spec_Sloc)).Instance; + + pragma Assert + (Sloc (Inst_Node) = Instances.Table (Inst_Spec_Inst_Id)); + Snew.Instance := Inst_Spec_Inst_Id; + end; + + else + Instances.Append (Sloc (Inst_Node)); + Snew.Instance := Instances.Last; + end if; + end if; + + -- Now compute the new values of Source_First and Source_Last and + -- adjust the source file pointer to have the correct bounds for the + -- new range of values. + + -- Source_First must be greater than the last Source_Last value and + -- also must be a multiple of Source_Align. + + Snew.Source_First := + ((Source_File.Table (Xnew - 1).Source_Last + Source_Align) / + Source_Align) * Source_Align; + Factor.Adjust := Snew.Source_First - Factor.Lo; + Snew.Source_Last := Factor.Hi + Factor.Adjust; + + Set_Source_File_Index_Table (Xnew); + + Snew.Sloc_Adjust := Sold.Sloc_Adjust - Factor.Adjust; + + -- Modify the Dope of the instance Source_Text to use the + -- above-computed bounds. + + declare + Dope : constant Dope_Ptr := + new Dope_Rec'(Snew.Source_First, Snew.Source_Last); + begin + Snew.Source_Text := Sold.Source_Text; + Set_Dope (Snew.Source_Text'Address, Dope); + pragma Assert (Snew.Source_Text'First = Snew.Source_First); + pragma Assert (Snew.Source_Text'Last = Snew.Source_Last); + end; + + if Debug_Flag_L then + Write_Str (" for "); + + if Nkind (Dnod) in N_Proper_Body + and then Was_Originally_Stub (Dnod) + then + Write_Str ("subunit "); + + elsif Ekind (Template_Id) = E_Generic_Package then + if Nkind (Dnod) = N_Package_Body then + Write_Str ("body of package "); + else + Write_Str ("spec of package "); + end if; + + elsif Ekind (Template_Id) = E_Function then + Write_Str ("body of function "); + + elsif Ekind (Template_Id) = E_Procedure then + Write_Str ("body of procedure "); + + elsif Ekind (Template_Id) = E_Generic_Function then + Write_Str ("spec of function "); + + elsif Ekind (Template_Id) = E_Generic_Procedure then + Write_Str ("spec of procedure "); + + elsif Ekind (Template_Id) = E_Package_Body then + Write_Str ("body of package "); + + else pragma Assert (Ekind (Template_Id) = E_Subprogram_Body); + if Nkind (Dnod) = N_Procedure_Specification then + Write_Str ("body of procedure "); + else + Write_Str ("body of function "); + end if; + end if; + + Write_Name (Chars (Template_Id)); + Write_Eol; + + Write_Str (" copying from file name = "); + Write_Name (File_Name (Xold)); + Write_Eol; + + Write_Str (" old source index = "); + Write_Int (Int (Xold)); + Write_Eol; + + Write_Str (" old lo = "); + Write_Int (Int (Factor.Lo)); + Write_Eol; + + Write_Str (" old hi = "); + Write_Int (Int (Factor.Hi)); + Write_Eol; + + Write_Str (" new lo = "); + Write_Int (Int (Snew.Source_First)); + Write_Eol; + + Write_Str (" new hi = "); + Write_Int (Int (Snew.Source_Last)); + Write_Eol; + + Write_Str (" adjustment factor = "); + Write_Int (Int (Factor.Adjust)); + Write_Eol; + + Write_Str (" instantiation location: "); + Write_Location (Sloc (Inst_Node)); + Write_Eol; + end if; + end; + end Create_Instantiation_Source; + + ---------------------- + -- Load_Config_File -- + ---------------------- + + function Load_Config_File + (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 : Osint.File_Type) return Source_File_Index + is + FD : File_Descriptor; + Hi : Source_Ptr; + Lo : Source_Ptr; + Src : Source_Buffer_Ptr; + X : Source_File_Index; + + Preprocessing_Needed : Boolean := False; + + begin + -- 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; + + if Debug_Flag_L then + Write_Eol; + Write_Str ("Sinput.L.Load_File: created source "); + Write_Int (Int (X)); + Write_Str (" for "); + Write_Str (Get_Name_String (N)); + end if; + + -- Compute starting index, respecting alignment requirement + + if X = Source_File.First then + Lo := First_Source_Ptr; + else + Lo := ((Source_File.Table (X - 1).Source_Last + Source_Align) / + Source_Align) * Source_Align; + end if; + + Osint.Read_Source_File (N, Lo, Hi, Src, FD, T); + + if Null_Source_Buffer_Ptr (Src) then + Source_File.Decrement_Last; + + if FD = Null_FD then + return No_Source_File; + else + return No_Access_To_Source_File; + end if; + else + if Debug_Flag_L then + Write_Eol; + Write_Str ("*** Build source file table entry, Index = "); + Write_Int (Int (X)); + Write_Str (", file name = "); + Write_Name (N); + Write_Eol; + Write_Str (" lo = "); + Write_Int (Int (Lo)); + Write_Eol; + Write_Str (" hi = "); + Write_Int (Int (Hi)); + Write_Eol; + + Write_Str (" first 10 chars -->"); + + declare + procedure Wchar (C : Character); + -- Writes character or ? for control character + + ----------- + -- Wchar -- + ----------- + + procedure Wchar (C : Character) is + begin + if C < ' ' + or else C in ASCII.DEL .. Character'Val (16#9F#) + then + Write_Char ('?'); + else + Write_Char (C); + end if; + end Wchar; + + begin + for J in Lo .. Lo + 9 loop + Wchar (Src (J)); + end loop; + + Write_Str ("<--"); + Write_Eol; + + Write_Str (" last 10 chars -->"); + + for J in Hi - 10 .. Hi - 1 loop + Wchar (Src (J)); + end loop; + + Write_Str ("<--"); + Write_Eol; + + if Src (Hi) /= EOF then + Write_Str (" error: no EOF at end"); + Write_Eol; + end if; + end; + end if; + + declare + S : Source_File_Record renames Source_File.Table (X); + File_Type : Type_Of_File; + + begin + 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_Debug_Name => Osint.Full_Source_Name, + Full_File_Name => Osint.Full_Source_Name, + Full_Ref_Name => Osint.Full_Source_Name, + Instance => No_Instance_Id, + Identifier_Casing => Unknown, + Inlined_Call => No_Location, + Inlined_Body => False, + Inherited_Pragma => False, + Keyword_Casing => Unknown, + Last_Source_Line => 1, + License => Unknown, + Lines_Table => null, + Lines_Table_Max => 1, + Logical_Lines_Table => null, + Num_SRef_Pragmas => 0, + Reference_Name => N, + Sloc_Adjust => 0, + Source_Checksum => 0, + Source_First => Lo, + Source_Last => Hi, + Source_Text => Src, + Template => No_Source_File, + Unit => No_Unit, + Time_Stamp => Osint.Current_Source_File_Stamp, + Index => X); + + 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 + + -- Temporarily set the Source_File_Index_Table entries for the + -- source, to avoid crash when reporting an error. + + Set_Source_File_Index_Table (X); + + 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 hooks + + Prep.Setup_Hooks + (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; + + -- The actual preprocessing step + + 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. Only + -- do that for the main unit (spec, body and subunits). + + if Generate_Processed_File + and then Modified + and then + ((Compiler_State = Parsing + and then Parsing_Main_Extended_Source) + or else + (Compiler_State = Analyzing + and then Analysing_Subunit_Of_Main)) + then + declare + FD : File_Descriptor; + NB : Integer; + Status : Boolean; + + begin + Get_Name_String (N); + Add_Str_To_Name_Buffer (Prep_Suffix); + + 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); + end if; + end; + end if; + + -- Set the new value of Hi + + Hi := Lo + Source_Ptr (Prep_Buffer_Last); + + -- Create the new source buffer + + declare + Var_Ptr : constant Source_Buffer_Ptr_Var := + new Source_Buffer (Lo .. Hi); + -- Allocate source buffer, allowing extra character at + -- end for EOF. + + begin + Var_Ptr (Lo .. Hi - 1) := + Prep_Buffer (1 .. Prep_Buffer_Last); + Var_Ptr (Hi) := EOF; + Src := Var_Ptr.all'Access; + end; + + -- 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 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 + is + begin + return Load_File (N, Osint.Source); + end Load_Source_File; + + ---------------------------- + -- New_EOL_In_Prep_Buffer -- + ---------------------------- + + procedure New_EOL_In_Prep_Buffer is + begin + Put_Char_In_Prep_Buffer (ASCII.LF); + end New_EOL_In_Prep_Buffer; + + ----------------------------- + -- Put_Char_In_Prep_Buffer -- + ----------------------------- + + procedure Put_Char_In_Prep_Buffer (C : Character) is + begin + -- If preprocessing buffer is not large enough, double it + + if Prep_Buffer_Last = Prep_Buffer'Last then + declare + New_Prep_Buffer : constant Text_Buffer_Ptr := + new Text_Buffer (1 .. 2 * Prep_Buffer_Last); + + begin + New_Prep_Buffer (Prep_Buffer'Range) := Prep_Buffer.all; + Free (Prep_Buffer); + Prep_Buffer := New_Prep_Buffer; + end; + end if; + + Prep_Buffer_Last := Prep_Buffer_Last + 1; + Prep_Buffer (Prep_Buffer_Last) := C; + end Put_Char_In_Prep_Buffer; + + ------------------------- + -- Source_File_Is_Body -- + ------------------------- + + function Source_File_Is_Body (X : Source_File_Index) return Boolean is + Pcount : Natural; + + begin + Initialize_Scanner (No_Unit, X); + + -- Loop to look for subprogram or package body + + loop + case Token is + + -- PRAGMA, WITH, USE (which can appear before a body) + + when Tok_Pragma + | Tok_Use + | Tok_With + => + -- We just want to skip any of these, do it by skipping to a + -- semicolon, but check for EOF, in case we have bad syntax. + + loop + if Token = Tok_Semicolon then + Scan; + exit; + elsif Token = Tok_EOF then + return False; + else + Scan; + end if; + end loop; + + -- PACKAGE + + when Tok_Package => + Scan; -- Past PACKAGE + + -- We have a body if and only if BODY follows + + return Token = Tok_Body; + + -- FUNCTION or PROCEDURE + + when Tok_Function + | Tok_Procedure + => + Pcount := 0; + + -- Loop through tokens following PROCEDURE or FUNCTION + + loop + Scan; + + case Token is + + -- For parens, count paren level (note that paren level + -- can get greater than 1 if we have default parameters). + + when Tok_Left_Paren => + Pcount := Pcount + 1; + + when Tok_Right_Paren => + Pcount := Pcount - 1; + + -- EOF means something weird, probably no body + + when Tok_EOF => + return False; + + -- BEGIN or IS or END definitely means body is present + + when Tok_Begin + | Tok_End + | Tok_Is + => + return True; + + -- Semicolon means no body present if at outside any + -- parens. If within parens, ignore, since it could be + -- a parameter separator. + + when Tok_Semicolon => + if Pcount = 0 then + return False; + end if; + + -- Skip anything else + + when others => + null; + end case; + end loop; + + -- Anything else in main scan means we don't have a body + + when others => + return False; + end case; + end loop; + end Source_File_Is_Body; + + ---------------------------- + -- Source_File_Is_No_Body -- + ---------------------------- + + function Source_File_Is_No_Body (X : Source_File_Index) return Boolean is + begin + Initialize_Scanner (No_Unit, X); + + if Token /= Tok_Pragma then + return False; + end if; + + Scan; -- past pragma + + if Token /= Tok_Identifier + or else Chars (Token_Node) /= Name_No_Body + then + return False; + end if; + + Scan; -- past No_Body + + if Token /= Tok_Semicolon then + return False; + end if; + + Scan; -- past semicolon + + return Token = Tok_EOF; + end Source_File_Is_No_Body; + +end Sinput.L;