gcc/ada/sinput-l.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                             S I N P U T . L                              --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
  19 -- http://www.gnu.org/licenses for a complete copy of the license.          --
  20 --                                                                          --
  21 -- GNAT was originally developed  by the GNAT team at  New York University. --
  22 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  23 --                                                                          --
  24 ------------------------------------------------------------------------------
  25
  26 with Alloc;
  27 with Atree;    use Atree;
  28 with Debug;    use Debug;
  29 with Einfo;    use Einfo;
  30 with Errout;   use Errout;
  31 with Opt;      use Opt;
  32 with Osint;    use Osint;
  33 with Output;   use Output;
  34 with Prep;     use Prep;
  35 with Prepcomp; use Prepcomp;
  36 with Scans;    use Scans;
  37 with Scn;      use Scn;
  38 with Sinfo;    use Sinfo;
  39 with Snames;   use Snames;
  40 with System;   use System;
  41
  42 with Unchecked_Conversion;
  43
  44 package body Sinput.L is
  45
  46    Prep_Buffer : Text_Buffer_Ptr := null;
  47    --  A buffer to temporarily stored the result of preprocessing a source.
  48    --  It is only allocated if there is at least one source to preprocess.
  49
  50    Prep_Buffer_Last : Text_Ptr := 0;
  51    --  Index of the last significant character in Prep_Buffer
  52
  53    Initial_Size_Of_Prep_Buffer : constant := 10_000;
  54    --  Size of Prep_Buffer when it is first allocated
  55
  56    --  When a file is to be preprocessed and the options to list symbols
  57    --  has been selected (switch -s), Prep.List_Symbols is called with a
  58    --  "foreword", a single line indicationg what source the symbols apply to.
  59    --  The following two constant String are the start and the end of this
  60    --  foreword.
  61
  62    Foreword_Start : constant String :=
  63                       "Preprocessing Symbols for source """;
  64
  65    Foreword_End : constant String := """";
  66
  67    -----------------
  68    -- Subprograms --
  69    -----------------
  70
  71    procedure Put_Char_In_Prep_Buffer (C : Character);
  72    --  Add one character in Prep_Buffer, extending Prep_Buffer if need be.
  73    --  Used to initialize the preprocessor.
  74
  75    procedure New_EOL_In_Prep_Buffer;
  76    --  Add an LF to Prep_Buffer (used to initialize the preprocessor)
  77
  78    function Load_File
  79      (N : File_Name_Type;
  80       T : Osint.File_Type) return Source_File_Index;
  81    --  Load a source file, a configuration pragmas file or a definition file
  82    --  Coding also allows preprocessing file, but not a library file ???
  83
  84    -------------------------------
  85    -- Adjust_Instantiation_Sloc --
  86    -------------------------------
  87
  88    procedure Adjust_Instantiation_Sloc (N : Node_Id; A : Sloc_Adjustment) is
  89       Loc : constant Source_Ptr := Sloc (N);
  90
  91    begin
  92       --  We only do the adjustment if the value is between the appropriate low
  93       --  and high values. It is not clear that this should ever not be the
  94       --  case, but in practice there seem to be some nodes that get copied
  95       --  twice, and this is a defence against that happening.
  96
  97       if A.Lo <= Loc and then Loc <= A.Hi then
  98          Set_Sloc (N, Loc + A.Adjust);
  99       end if;
 100    end Adjust_Instantiation_Sloc;
 101
 102    --------------------------------
 103    -- Complete_Source_File_Entry --
 104    --------------------------------
 105
 106    procedure Complete_Source_File_Entry is
 107       CSF : constant Source_File_Index := Current_Source_File;
 108
 109    begin
 110       Trim_Lines_Table (CSF);
 111       Source_File.Table (CSF).Source_Checksum := Checksum;
 112    end Complete_Source_File_Entry;
 113
 114    ---------------------------------
 115    -- Create_Instantiation_Source --
 116    ---------------------------------
 117
 118    procedure Create_Instantiation_Source
 119      (Inst_Node    : Entity_Id;
 120       Template_Id  : Entity_Id;
 121       Inlined_Body : Boolean;
 122       A            : out Sloc_Adjustment)
 123    is
 124       Dnod : constant Node_Id := Declaration_Node (Template_Id);
 125       Xold : Source_File_Index;
 126       Xnew : Source_File_Index;
 127
 128    begin
 129       Xold := Get_Source_File_Index (Sloc (Template_Id));
 130       A.Lo := Source_File.Table (Xold).Source_First;
 131       A.Hi := Source_File.Table (Xold).Source_Last;
 132
 133       Source_File.Append (Source_File.Table (Xold));
 134       Xnew := Source_File.Last;
 135
 136       Source_File.Table (Xnew).Inlined_Body  := Inlined_Body;
 137       Source_File.Table (Xnew).Instantiation := Sloc (Inst_Node);
 138       Source_File.Table (Xnew).Template      := Xold;
 139
 140       --  Now we need to compute the new values of Source_First, Source_Last
 141       --  and adjust the source file pointer to have the correct virtual
 142       --  origin for the new range of values.
 143
 144       Source_File.Table (Xnew).Source_First :=
 145         Source_File.Table (Xnew - 1).Source_Last + 1;
 146       A.Adjust := Source_File.Table (Xnew).Source_First - A.Lo;
 147       Source_File.Table (Xnew).Source_Last := A.Hi + A.Adjust;
 148
 149       Set_Source_File_Index_Table (Xnew);
 150
 151       Source_File.Table (Xnew).Sloc_Adjust :=
 152         Source_File.Table (Xold).Sloc_Adjust - A.Adjust;
 153
 154       if Debug_Flag_L then
 155          Write_Eol;
 156          Write_Str ("*** Create instantiation source for ");
 157
 158          if Nkind (Dnod) in N_Proper_Body
 159            and then Was_Originally_Stub (Dnod)
 160          then
 161             Write_Str ("subunit ");
 162
 163          elsif Ekind (Template_Id) = E_Generic_Package then
 164             if Nkind (Dnod) = N_Package_Body then
 165                Write_Str ("body of package ");
 166             else
 167                Write_Str ("spec of package ");
 168             end if;
 169
 170          elsif Ekind (Template_Id) = E_Function then
 171             Write_Str ("body of function ");
 172
 173          elsif Ekind (Template_Id) = E_Procedure then
 174             Write_Str ("body of procedure ");
 175
 176          elsif Ekind (Template_Id) = E_Generic_Function then
 177             Write_Str ("spec of function ");
 178
 179          elsif Ekind (Template_Id) = E_Generic_Procedure then
 180             Write_Str ("spec of procedure ");
 181
 182          elsif Ekind (Template_Id) = E_Package_Body then
 183             Write_Str ("body of package ");
 184
 185          else pragma Assert (Ekind (Template_Id) = E_Subprogram_Body);
 186
 187             if Nkind (Dnod) = N_Procedure_Specification then
 188                Write_Str ("body of procedure ");
 189             else
 190                Write_Str ("body of function ");
 191             end if;
 192          end if;
 193
 194          Write_Name (Chars (Template_Id));
 195          Write_Eol;
 196
 197          Write_Str ("  new source index = ");
 198          Write_Int (Int (Xnew));
 199          Write_Eol;
 200
 201          Write_Str ("  copying from file name = ");
 202          Write_Name (File_Name (Xold));
 203          Write_Eol;
 204
 205          Write_Str ("  old source index = ");
 206          Write_Int (Int (Xold));
 207          Write_Eol;
 208
 209          Write_Str ("  old lo = ");
 210          Write_Int (Int (A.Lo));
 211          Write_Eol;
 212
 213          Write_Str ("  old hi = ");
 214          Write_Int (Int (A.Hi));
 215          Write_Eol;
 216
 217          Write_Str ("  new lo = ");
 218          Write_Int (Int (Source_File.Table (Xnew).Source_First));
 219          Write_Eol;
 220
 221          Write_Str ("  new hi = ");
 222          Write_Int (Int (Source_File.Table (Xnew).Source_Last));
 223          Write_Eol;
 224
 225          Write_Str ("  adjustment factor = ");
 226          Write_Int (Int (A.Adjust));
 227          Write_Eol;
 228
 229          Write_Str ("  instantiation location: ");
 230          Write_Location (Sloc (Inst_Node));
 231          Write_Eol;
 232       end if;
 233
 234       --  For a given character in the source, a higher subscript will be used
 235       --  to access the instantiation, which means that the virtual origin must
 236       --  have a corresponding lower value. We compute this new origin by
 237       --  taking the address of the appropriate adjusted element in the old
 238       --  array. Since this adjusted element will be at a negative subscript,
 239       --  we must suppress checks.
 240
 241       declare
 242          pragma Suppress (All_Checks);
 243
 244          pragma Warnings (Off);
 245          --  This unchecked conversion is aliasing safe, since it is never used
 246          --  to create improperly aliased pointer values.
 247
 248          function To_Source_Buffer_Ptr is new
 249            Unchecked_Conversion (Address, Source_Buffer_Ptr);
 250
 251          pragma Warnings (On);
 252
 253       begin
 254          Source_File.Table (Xnew).Source_Text :=
 255            To_Source_Buffer_Ptr
 256              (Source_File.Table (Xold).Source_Text (-A.Adjust)'Address);
 257       end;
 258    end Create_Instantiation_Source;
 259
 260    ----------------------
 261    -- Load_Config_File --
 262    ----------------------
 263
 264    function Load_Config_File
 265      (N : File_Name_Type) return Source_File_Index
 266    is
 267    begin
 268       return Load_File (N, Osint.Config);
 269    end Load_Config_File;
 270
 271    --------------------------
 272    -- Load_Definition_File --
 273    --------------------------
 274
 275    function Load_Definition_File
 276      (N : File_Name_Type) return Source_File_Index
 277    is
 278    begin
 279       return Load_File (N, Osint.Definition);
 280    end Load_Definition_File;
 281
 282    ---------------
 283    -- Load_File --
 284    ---------------
 285
 286    function Load_File
 287      (N : File_Name_Type;
 288       T : Osint.File_Type) return Source_File_Index
 289    is
 290       Src : Source_Buffer_Ptr;
 291       X   : Source_File_Index;
 292       Lo  : Source_Ptr;
 293       Hi  : Source_Ptr;
 294
 295       Preprocessing_Needed : Boolean := False;
 296
 297    begin
 298       --  If already there, don't need to reload file. An exception occurs
 299       --  in multiple unit per file mode. It would be nice in this case to
 300       --  share the same source file for each unit, but this leads to many
 301       --  difficulties with assumptions (e.g. in the body of lib), that a
 302       --  unit can be found by locating its source file index. Since we do
 303       --  not expect much use of this mode, it's no big deal to waste a bit
 304       --  of space and time by reading and storing the source multiple times.
 305
 306       if Multiple_Unit_Index = 0 then
 307          for J in 1 .. Source_File.Last loop
 308             if Source_File.Table (J).File_Name = N then
 309                return J;
 310             end if;
 311          end loop;
 312       end if;
 313
 314       --  Here we must build a new entry in the file table
 315
 316       --  But first, we must check if a source needs to be preprocessed,
 317       --  because we may have to load and parse a definition file, and we want
 318       --  to do that before we load the source, so that the buffer of the
 319       --  source will be the last created, and we will be able to replace it
 320       --  and modify Hi without stepping on another buffer.
 321
 322       if T = Osint.Source then
 323          Prepare_To_Preprocess
 324            (Source => N, Preprocessing_Needed => Preprocessing_Needed);
 325       end if;
 326
 327       Source_File.Increment_Last;
 328       X := Source_File.Last;
 329
 330       if X = Source_File.First then
 331          Lo := First_Source_Ptr;
 332       else
 333          Lo := Source_File.Table (X - 1).Source_Last + 1;
 334       end if;
 335
 336       Osint.Read_Source_File (N, Lo, Hi, Src, T);
 337
 338       if Src = null then
 339          Source_File.Decrement_Last;
 340          return No_Source_File;
 341
 342       else
 343          if Debug_Flag_L then
 344             Write_Eol;
 345             Write_Str ("*** Build source file table entry, Index = ");
 346             Write_Int (Int (X));
 347             Write_Str (", file name = ");
 348             Write_Name (N);
 349             Write_Eol;
 350             Write_Str ("  lo = ");
 351             Write_Int (Int (Lo));
 352             Write_Eol;
 353             Write_Str ("  hi = ");
 354             Write_Int (Int (Hi));
 355             Write_Eol;
 356
 357             Write_Str ("  first 10 chars -->");
 358
 359             declare
 360                procedure Wchar (C : Character);
 361                --  Writes character or ? for control character
 362
 363                procedure Wchar (C : Character) is
 364                begin
 365                   if C < ' ' or C in ASCII.DEL .. Character'Val (16#9F#) then
 366                      Write_Char ('?');
 367                   else
 368                      Write_Char (C);
 369                   end if;
 370                end Wchar;
 371
 372             begin
 373                for J in Lo .. Lo + 9 loop
 374                   Wchar (Src (J));
 375                end loop;
 376
 377                Write_Str ("<--");
 378                Write_Eol;
 379
 380                Write_Str ("  last 10 chars  -->");
 381
 382                for J in Hi - 10 .. Hi - 1 loop
 383                   Wchar (Src (J));
 384                end loop;
 385
 386                Write_Str ("<--");
 387                Write_Eol;
 388
 389                if Src (Hi) /= EOF then
 390                   Write_Str ("  error: no EOF at end");
 391                   Write_Eol;
 392                end if;
 393             end;
 394          end if;
 395
 396          declare
 397             S         : Source_File_Record renames Source_File.Table (X);
 398             File_Type : Type_Of_File;
 399
 400          begin
 401             case T is
 402                when Osint.Source =>
 403                   File_Type := Sinput.Src;
 404
 405                when Osint.Library =>
 406                   raise Program_Error;
 407
 408                when Osint.Config =>
 409                   File_Type := Sinput.Config;
 410
 411                when Osint.Definition =>
 412                   File_Type := Def;
 413
 414                when Osint.Preprocessing_Data =>
 415                   File_Type := Preproc;
 416             end case;
 417
 418             S := (Debug_Source_Name   => N,
 419                   File_Name           => N,
 420                   File_Type           => File_Type,
 421                   First_Mapped_Line   => No_Line_Number,
 422                   Full_Debug_Name     => Osint.Full_Source_Name,
 423                   Full_File_Name      => Osint.Full_Source_Name,
 424                   Full_Ref_Name       => Osint.Full_Source_Name,
 425                   Identifier_Casing   => Unknown,
 426                   Inlined_Body        => False,
 427                   Instantiation       => No_Location,
 428                   Keyword_Casing      => Unknown,
 429                   Last_Source_Line    => 1,
 430                   License             => Unknown,
 431                   Lines_Table         => null,
 432                   Lines_Table_Max     => 1,
 433                   Logical_Lines_Table => null,
 434                   Num_SRef_Pragmas    => 0,
 435                   Reference_Name      => N,
 436                   Sloc_Adjust         => 0,
 437                   Source_Checksum     => 0,
 438                   Source_First        => Lo,
 439                   Source_Last         => Hi,
 440                   Source_Text         => Src,
 441                   Template            => No_Source_File,
 442                   Unit                => No_Unit,
 443                   Time_Stamp          => Osint.Current_Source_File_Stamp);
 444
 445             Alloc_Line_Tables (S, Opt.Table_Factor * Alloc.Lines_Initial);
 446             S.Lines_Table (1) := Lo;
 447          end;
 448
 449          --  Preprocess the source if it needs to be preprocessed
 450
 451          if Preprocessing_Needed then
 452             if Opt.List_Preprocessing_Symbols then
 453                Get_Name_String (N);
 454
 455                declare
 456                   Foreword : String (1 .. Foreword_Start'Length +
 457                                           Name_Len + Foreword_End'Length);
 458
 459                begin
 460                   Foreword (1 .. Foreword_Start'Length) := Foreword_Start;
 461                   Foreword (Foreword_Start'Length + 1 ..
 462                               Foreword_Start'Length + Name_Len) :=
 463                     Name_Buffer (1 .. Name_Len);
 464                   Foreword (Foreword'Last - Foreword_End'Length + 1 ..
 465                               Foreword'Last) := Foreword_End;
 466                   Prep.List_Symbols (Foreword);
 467                end;
 468             end if;
 469
 470             declare
 471                T : constant Nat := Total_Errors_Detected;
 472                --  Used to check if there were errors during preprocessing
 473
 474                Save_Style_Check : Boolean;
 475                --  Saved state of the Style_Check flag (which needs to be
 476                --  temporarily set to False during preprocessing, see below).
 477
 478             begin
 479                --  If this is the first time we preprocess a source, allocate
 480                --  the preprocessing buffer.
 481
 482                if Prep_Buffer = null then
 483                   Prep_Buffer :=
 484                     new Text_Buffer (1 .. Initial_Size_Of_Prep_Buffer);
 485                end if;
 486
 487                --  Make sure the preprocessing buffer is empty
 488
 489                Prep_Buffer_Last := 0;
 490
 491                --  Initialize the preprocessor
 492
 493                Prep.Initialize
 494                  (Error_Msg         => Errout.Error_Msg'Access,
 495                   Scan              => Scn.Scanner.Scan'Access,
 496                   Set_Ignore_Errors => Errout.Set_Ignore_Errors'Access,
 497                   Put_Char          => Put_Char_In_Prep_Buffer'Access,
 498                   New_EOL           => New_EOL_In_Prep_Buffer'Access);
 499
 500                --  Initialize scanner and set its behavior for preprocessing,
 501                --  then preprocess. Also disable style checks, since some of
 502                --  them are done in the scanner (specifically, those dealing
 503                --  with line length and line termination), and cannot be done
 504                --  during preprocessing (because the source file index table
 505                --  has not been set yet).
 506
 507                Scn.Scanner.Initialize_Scanner (X);
 508
 509                Scn.Scanner.Set_Special_Character ('#');
 510                Scn.Scanner.Set_Special_Character ('$');
 511                Scn.Scanner.Set_End_Of_Line_As_Token (True);
 512                Save_Style_Check := Opt.Style_Check;
 513                Opt.Style_Check := False;
 514
 515                Preprocess;
 516
 517                --  Reset the scanner to its standard behavior, and restore the
 518                --  Style_Checks flag.
 519
 520                Scn.Scanner.Reset_Special_Characters;
 521                Scn.Scanner.Set_End_Of_Line_As_Token (False);
 522                Opt.Style_Check := Save_Style_Check;
 523
 524                --  If there were errors during preprocessing, record an error
 525                --  at the start of the file, and do not change the source
 526                --  buffer.
 527
 528                if T /= Total_Errors_Detected then
 529                   Errout.Error_Msg
 530                     ("file could not be successfully preprocessed", Lo);
 531                   return No_Source_File;
 532
 533                else
 534                   --  Set the new value of Hi
 535
 536                   Hi := Lo + Source_Ptr (Prep_Buffer_Last);
 537
 538                   --  Create the new source buffer
 539
 540                   declare
 541                      subtype Actual_Source_Buffer is Source_Buffer (Lo .. Hi);
 542                      --  Physical buffer allocated
 543
 544                      type Actual_Source_Ptr is access Actual_Source_Buffer;
 545                      --  Pointer type for the physical buffer allocated
 546
 547                      Actual_Ptr : constant Actual_Source_Ptr :=
 548                                     new Actual_Source_Buffer;
 549                      --  Actual physical buffer
 550
 551                   begin
 552                      Actual_Ptr (Lo .. Hi - 1) :=
 553                        Prep_Buffer (1 .. Prep_Buffer_Last);
 554                      Actual_Ptr (Hi) := EOF;
 555
 556                      --  Now we need to work out the proper virtual origin
 557                      --  pointer to return. This is Actual_Ptr (0)'Address, but
 558                      --  we have to be careful to suppress checks to compute
 559                      --  this address.
 560
 561                      declare
 562                         pragma Suppress (All_Checks);
 563
 564                         pragma Warnings (Off);
 565                         --  This unchecked conversion is aliasing safe, since
 566                         --  it is never used to create improperly aliased
 567                         --  pointer values.
 568
 569                         function To_Source_Buffer_Ptr is new
 570                           Unchecked_Conversion (Address, Source_Buffer_Ptr);
 571
 572                         pragma Warnings (On);
 573
 574                      begin
 575                         Src := To_Source_Buffer_Ptr (Actual_Ptr (0)'Address);
 576
 577                         --  Record in the table the new source buffer and the
 578                         --  new value of Hi.
 579
 580                         Source_File.Table (X).Source_Text := Src;
 581                         Source_File.Table (X).Source_Last := Hi;
 582
 583                         --  Reset Last_Line to 1, because the lines do not
 584                         --  have neccessarily the same starts and lengths.
 585
 586                         Source_File.Table (X).Last_Source_Line := 1;
 587                      end;
 588                   end;
 589                end if;
 590             end;
 591          end if;
 592
 593          Set_Source_File_Index_Table (X);
 594          return X;
 595       end if;
 596    end Load_File;
 597
 598    ----------------------------------
 599    -- Load_Preprocessing_Data_File --
 600    ----------------------------------
 601
 602    function Load_Preprocessing_Data_File
 603      (N : File_Name_Type) return Source_File_Index
 604    is
 605    begin
 606       return Load_File (N, Osint.Preprocessing_Data);
 607    end Load_Preprocessing_Data_File;
 608
 609    ----------------------
 610    -- Load_Source_File --
 611    ----------------------
 612
 613    function Load_Source_File
 614      (N : File_Name_Type) return Source_File_Index
 615    is
 616    begin
 617       return Load_File (N, Osint.Source);
 618    end Load_Source_File;
 619
 620    ----------------------------
 621    -- New_EOL_In_Prep_Buffer --
 622    ----------------------------
 623
 624    procedure New_EOL_In_Prep_Buffer is
 625    begin
 626       Put_Char_In_Prep_Buffer (ASCII.LF);
 627    end New_EOL_In_Prep_Buffer;
 628
 629    -----------------------------
 630    -- Put_Char_In_Prep_Buffer --
 631    -----------------------------
 632
 633    procedure Put_Char_In_Prep_Buffer (C : Character) is
 634    begin
 635       --  If preprocessing buffer is not large enough, double it
 636
 637       if Prep_Buffer_Last = Prep_Buffer'Last then
 638          declare
 639             New_Prep_Buffer : constant Text_Buffer_Ptr :=
 640               new Text_Buffer (1 .. 2 * Prep_Buffer_Last);
 641
 642          begin
 643             New_Prep_Buffer (Prep_Buffer'Range) := Prep_Buffer.all;
 644             Free (Prep_Buffer);
 645             Prep_Buffer := New_Prep_Buffer;
 646          end;
 647       end if;
 648
 649       Prep_Buffer_Last := Prep_Buffer_Last + 1;
 650       Prep_Buffer (Prep_Buffer_Last) := C;
 651    end Put_Char_In_Prep_Buffer;
 652
 653    -----------------------------------
 654    -- Source_File_Is_Pragma_No_Body --
 655    -----------------------------------
 656
 657    function Source_File_Is_No_Body (X : Source_File_Index) return Boolean is
 658    begin
 659       Initialize_Scanner (No_Unit, X);
 660
 661       if Token /= Tok_Pragma then
 662          return False;
 663       end if;
 664
 665       Scan; -- past pragma
 666
 667       if Token /= Tok_Identifier
 668         or else Chars (Token_Node) /= Name_No_Body
 669       then
 670          return False;
 671       end if;
 672
 673       Scan; -- past No_Body
 674
 675       if Token /= Tok_Semicolon then
 676          return False;
 677       end if;
 678
 679       Scan; -- past semicolon
 680
 681       return Token = Tok_EOF;
 682    end Source_File_Is_No_Body;
 683
 684    ----------------------------
 685    -- Source_File_Is_Subunit --
 686    ----------------------------
 687
 688    function Source_File_Is_Subunit (X : Source_File_Index) return Boolean is
 689    begin
 690       Initialize_Scanner (No_Unit, X);
 691
 692       --  We scan past junk to the first interesting compilation unit token, to
 693       --  see if it is SEPARATE. We ignore WITH keywords during this and also
 694       --  PRIVATE. The reason for ignoring PRIVATE is that it handles some
 695       --  error situations, and also to handle PRIVATE WITH in Ada 2005 mode.
 696
 697       while Token = Tok_With
 698         or else Token = Tok_Private
 699         or else (Token not in Token_Class_Cunit and then Token /= Tok_EOF)
 700       loop
 701          Scan;
 702       end loop;
 703
 704       return Token = Tok_Separate;
 705    end Source_File_Is_Subunit;
 706
 707 end Sinput.L;