gcc/ada/makeutl.ads

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                              M A K E U T L                               --
   6 --                                                                          --
   7 --                                 S p e c                                  --
   8 --                                                                          --
   9 --          Copyright (C) 2004-2012, 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 --  This package contains various subprograms used by the builders, in
  27 --  particular those subprograms related to project management and build
  28 --  queue management.
  29
  30 with ALI;
  31 with Namet;    use Namet;
  32 with Opt;
  33 with Osint;
  34 with Prj;      use Prj;
  35 with Prj.Tree;
  36 with Snames;   use Snames;
  37 with Table;
  38 with Types;    use Types;
  39
  40 with GNAT.OS_Lib; use GNAT.OS_Lib;
  41
  42 package Makeutl is
  43
  44    type Fail_Proc is access procedure (S : String);
  45    --  Pointer to procedure which outputs a failure message
  46
  47    On_Windows : constant Boolean := Directory_Separator = '\';
  48    --  True when on Windows
  49
  50    Source_Info_Option : constant String := "--source-info=";
  51    --  Switch to indicate the source info file
  52
  53    Subdirs_Option : constant String := "--subdirs=";
  54    --  Switch used to indicate that the real directories (object, exec,
  55    --  library, ...) are subdirectories of those in the project file.
  56
  57    Unchecked_Shared_Lib_Imports : constant String :=
  58                                     "--unchecked-shared-lib-imports";
  59    --  Command line switch to allow shared library projects to import projects
  60    --  that are not shared library projects.
  61
  62    Single_Compile_Per_Obj_Dir_Switch : constant String :=
  63                                          "--single-compile-per-obj-dir";
  64    --  Switch to forbid simultaneous compilations for the same object directory
  65    --  when project files are used.
  66
  67    Create_Map_File_Switch : constant String := "--create-map-file";
  68    --  Switch to create a map file when an executable is linked
  69
  70    package Directories is new Table.Table
  71      (Table_Component_Type => Path_Name_Type,
  72       Table_Index_Type     => Integer,
  73       Table_Low_Bound      => 1,
  74       Table_Initial        => 200,
  75       Table_Increment      => 100,
  76       Table_Name           => "Makegpr.Directories");
  77    --  Table of all the source or object directories, filled up by
  78    --  Get_Directories.
  79
  80    procedure Add
  81      (Option : String_Access;
  82       To     : in out String_List_Access;
  83       Last   : in out Natural);
  84    procedure Add
  85      (Option : String;
  86       To     : in out String_List_Access;
  87       Last   : in out Natural);
  88    --  Add a string to a list of strings
  89
  90    function Create_Binder_Mapping_File
  91      (Project_Tree : Project_Tree_Ref) return Path_Name_Type;
  92    --  Create a binder mapping file and returns its path name
  93
  94    function Create_Name (Name : String) return File_Name_Type;
  95    function Create_Name (Name : String) return Name_Id;
  96    function Create_Name (Name : String) return Path_Name_Type;
  97    --  Get an id for a name
  98
  99    function Base_Name_Index_For
 100      (Main            : String;
 101       Main_Index      : Int;
 102       Index_Separator : Character) return File_Name_Type;
 103    --  Returns the base name of Main, without the extension, followed by the
 104    --  Index_Separator followed by the Main_Index if it is non-zero.
 105
 106    function Executable_Prefix_Path return String;
 107    --  Return the absolute path parent directory of the directory where the
 108    --  current executable resides, if its directory is named "bin", otherwise
 109    --  return an empty string. When a directory is returned, it is guaranteed
 110    --  to end with a directory separator.
 111
 112    procedure Inform (N : Name_Id := No_Name; Msg : String);
 113    procedure Inform (N : File_Name_Type; Msg : String);
 114    --  Prints out the program name followed by a colon, N and S
 115
 116    function File_Not_A_Source_Of
 117      (Project_Tree : Project_Tree_Ref;
 118       Uname        : Name_Id;
 119       Sfile        : File_Name_Type) return Boolean;
 120    --  Check that file name Sfile is one of the source of unit Uname. Returns
 121    --  True if the unit is in one of the project file, but the file name is not
 122    --  one of its source. Returns False otherwise.
 123
 124    function Check_Source_Info_In_ALI
 125      (The_ALI      : ALI.ALI_Id;
 126       Tree         : Project_Tree_Ref) return Name_Id;
 127    --  Check whether all file references in ALI are still valid (i.e. the
 128    --  source files are still associated with the same units). Return the name
 129    --  of the unit if everything is still valid. Return No_Name otherwise.
 130
 131    function Is_Subunit (Source : Source_Id) return Boolean;
 132    --  Return True if source is a subunit
 133
 134    procedure Initialize_Source_Record (Source : Source_Id);
 135    --  Get information either about the source file, or the object and
 136    --  dependency file, as well as their timestamps.
 137
 138    function Is_External_Assignment
 139      (Env  : Prj.Tree.Environment;
 140       Argv : String) return Boolean;
 141    --  Verify that an external assignment switch is syntactically correct
 142    --
 143    --  Correct forms are:
 144    --
 145    --      -Xname=value
 146    --      -X"name=other value"
 147    --
 148    --  Assumptions: 'First = 1, Argv (1 .. 2) = "-X"
 149    --
 150    --  When this function returns True, the external assignment has been
 151    --  entered by a call to Prj.Ext.Add, so that in a project file, External
 152    --  ("name") will return "value".
 153
 154    procedure Verbose_Msg
 155      (N1                : Name_Id;
 156       S1                : String;
 157       N2                : Name_Id := No_Name;
 158       S2                : String  := "";
 159       Prefix            : String  := "  -> ";
 160       Minimum_Verbosity : Opt.Verbosity_Level_Type := Opt.Low);
 161    procedure Verbose_Msg
 162      (N1                : File_Name_Type;
 163       S1                : String;
 164       N2                : File_Name_Type := No_File;
 165       S2                : String  := "";
 166       Prefix            : String  := "  -> ";
 167       Minimum_Verbosity : Opt.Verbosity_Level_Type := Opt.Low);
 168    --  If the verbose flag (Verbose_Mode) is set and the verbosity level is at
 169    --  least equal to Minimum_Verbosity, then print Prefix to standard output
 170    --  followed by N1 and S1. If N2 /= No_Name then N2 is printed after S1. S2
 171    --  is printed last. Both N1 and N2 are printed in quotation marks. The two
 172    --  forms differ only in taking Name_Id or File_name_Type arguments.
 173
 174    type Name_Ids is array (Positive range <>) of Name_Id;
 175    No_Names : constant Name_Ids := (1 .. 0 => No_Name);
 176    --  Name_Ids is used for list of language names in procedure Get_Directories
 177    --  below.
 178
 179    Ada_Only : constant Name_Ids := (1 => Name_Ada);
 180    --  Used to invoke Get_Directories in gnatmake
 181
 182    type Activity_Type is (Compilation, Executable_Binding, SAL_Binding);
 183
 184    procedure Get_Directories
 185      (Project_Tree : Project_Tree_Ref;
 186       For_Project  : Project_Id;
 187       Activity     : Activity_Type;
 188       Languages    : Name_Ids);
 189    --  Put in table Directories the source (when Sources is True) or
 190    --  object/library (when Sources is False) directories of project
 191    --  For_Project and of all the project it imports directly or indirectly.
 192    --  The source directories of imported projects are only included if one
 193    --  of the declared languages is in the list Languages.
 194
 195    procedure Write_Path_File (FD : File_Descriptor);
 196    --  Write in the specified open path file the directories in table
 197    --  Directories, then closed the path file.
 198
 199    procedure Get_Switches
 200      (Source       : Source_Id;
 201       Pkg_Name     : Name_Id;
 202       Project_Tree : Project_Tree_Ref;
 203       Value        : out Variable_Value;
 204       Is_Default   : out Boolean);
 205    procedure Get_Switches
 206      (Source_File         : File_Name_Type;
 207       Source_Lang         : Name_Id;
 208       Source_Prj          : Project_Id;
 209       Pkg_Name            : Name_Id;
 210       Project_Tree        : Project_Tree_Ref;
 211       Value               : out Variable_Value;
 212       Is_Default          : out Boolean;
 213       Test_Without_Suffix : Boolean := False;
 214       Check_ALI_Suffix    : Boolean := False);
 215    --  Compute the switches (Compilation switches for instance) for the given
 216    --  file. This checks various attributes to see if there are file specific
 217    --  switches, or else defaults on the switches for the corresponding
 218    --  language. Is_Default is set to False if there were file-specific
 219    --  switches Source_File can be set to No_File to force retrieval of the
 220    --  default switches. If Test_Without_Suffix is True, and there is no " for
 221    --  Switches(Source_File) use", then this procedure also tests without the
 222    --  extension of the filename. If Test_Without_Suffix is True and
 223    --  Check_ALI_Suffix is True, then we also replace the file extension with
 224    --  ".ali" when testing.
 225
 226    function Linker_Options_Switches
 227      (Project  : Project_Id;
 228       Do_Fail  : Fail_Proc;
 229       In_Tree  : Project_Tree_Ref) return String_List;
 230    --  Collect the options specified in the Linker'Linker_Options attributes
 231    --  of project Project, in project tree In_Tree, and in the projects that
 232    --  it imports directly or indirectly, and returns the result.
 233
 234    function Unit_Index_Of (ALI_File : File_Name_Type) return Int;
 235    --  Find the index of a unit in a source file. Return zero if the file is
 236    --  not a multi-unit source file.
 237
 238    procedure Test_If_Relative_Path
 239      (Switch               : in out String_Access;
 240       Parent               : String;
 241       Do_Fail              : Fail_Proc;
 242       Including_L_Switch   : Boolean := True;
 243       Including_Non_Switch : Boolean := True;
 244       Including_RTS        : Boolean := False);
 245    --  Test if Switch is a relative search path switch. If so, fail if Parent
 246    --  is the empty string, otherwise prepend the path with Parent. This
 247    --  subprogram is only used when using project files. For gnatbind switches,
 248    --  Including_L_Switch is False, because the argument of the -L switch is
 249    --  not a path. If Including_RTS is True, process also switches --RTS=.
 250    --  Do_Fail is called in case of error. Using Osint.Fail might be
 251    --  appropriate.
 252
 253    function Path_Or_File_Name (Path : Path_Name_Type) return String;
 254    --  Returns a file name if -df is used, otherwise return a path name
 255
 256    -------------------------
 257    -- Program termination --
 258    -------------------------
 259
 260    procedure Fail_Program
 261      (Project_Tree   : Project_Tree_Ref;
 262       S              : String;
 263       Flush_Messages : Boolean := True);
 264    --  Terminate program with a message and a fatal status code
 265
 266    procedure Finish_Program
 267      (Project_Tree : Project_Tree_Ref;
 268       Exit_Code    : Osint.Exit_Code_Type := Osint.E_Success;
 269       S            : String := "");
 270    --  Terminate program, with or without a message, setting the status code
 271    --  according to Fatal. This properly removes all temporary files.
 272
 273    --------------
 274    -- Switches --
 275    --------------
 276
 277    generic
 278       with function Add_Switch
 279         (Switch      : String;
 280          For_Lang    : Name_Id;
 281          For_Builder : Boolean;
 282          Has_Global_Compilation_Switches : Boolean) return Boolean;
 283       --  For_Builder is true if we have a builder switch
 284       --  This function should return True in case of success (the switch is
 285       --  valid), False otherwise. The error message will be displayed by
 286       --  Compute_Builder_Switches itself.
 287       --  Has_Global_Compilation_Switches is True if the attribute
 288       --  Global_Compilation_Switches is defined in the project.
 289
 290    procedure Compute_Builder_Switches
 291      (Project_Tree     : Project_Tree_Ref;
 292       Root_Environment : in out Prj.Tree.Environment;
 293       Main_Project     : Project_Id;
 294       Only_For_Lang    : Name_Id := No_Name);
 295    --  Compute the builder switches and global compilation switches.
 296    --  Every time a switch is found in the project, it is passed to Add_Switch.
 297    --  You can provide a value for Only_For_Lang so that we only look for
 298    --  this language when parsing the global compilation switches.
 299
 300    -----------------------
 301    -- Project_Tree data --
 302    -----------------------
 303
 304    --  The following types are specific to builders, and associated with each
 305    --  of the loaded project trees.
 306
 307    type Binding_Data_Record;
 308    type Binding_Data is access Binding_Data_Record;
 309    type Binding_Data_Record is record
 310       Language           : Language_Ptr;
 311       Language_Name      : Name_Id;
 312       Binder_Driver_Name : File_Name_Type;
 313       Binder_Driver_Path : String_Access;
 314       Binder_Prefix      : Name_Id;
 315       Next               : Binding_Data;
 316    end record;
 317    --  Data for a language that have a binder driver
 318
 319    type Builder_Project_Tree_Data is new Project_Tree_Appdata with record
 320       Binding : Binding_Data;
 321
 322       There_Are_Binder_Drivers : Boolean := False;
 323       --  True when there is a binder driver. Set by Get_Configuration when
 324       --  an attribute Language_Processing'Binder_Driver is declared.
 325       --  Reset to False if there are no sources of the languages with binder
 326       --  drivers.
 327
 328       Number_Of_Mains : Natural := 0;
 329       --  Number of main units in this project tree
 330
 331       Closure_Needed : Boolean := False;
 332       --  If True, we need to add the closure of the file we just compiled to
 333       --  the queue. If False, it is assumed that all files are already on the
 334       --  queue so we do not waste time computing the closure.
 335
 336       Need_Compilation : Boolean := True;
 337       Need_Binding     : Boolean := True;
 338       Need_Linking     : Boolean := True;
 339       --  Which of the compilation phases are needed for this project tree
 340    end record;
 341    type Builder_Data_Access is access all Builder_Project_Tree_Data;
 342
 343    procedure Free (Data : in out Builder_Project_Tree_Data);
 344    --  Free all memory allocated for Data
 345
 346    function Builder_Data (Tree : Project_Tree_Ref) return Builder_Data_Access;
 347    --  Return (allocate if needed) tree-specific data
 348
 349    procedure Compute_Compilation_Phases
 350      (Tree                  : Project_Tree_Ref;
 351       Root_Project          : Project_Id;
 352       Option_Unique_Compile : Boolean := False;   --  Was "-u" specified ?
 353       Option_Compile_Only   : Boolean := False;   --  Was "-c" specified ?
 354       Option_Bind_Only      : Boolean := False;
 355       Option_Link_Only      : Boolean := False);
 356    --  Compute which compilation phases will be needed for Tree. This also does
 357    --  the computation for aggregated trees. This also check whether we'll need
 358    --  to check the closure of the files we have just compiled to add them to
 359    --  the queue.
 360
 361    -----------
 362    -- Mains --
 363    -----------
 364
 365    --  Package Mains is used to store the mains specified on the command line
 366    --  and to retrieve them when a project file is used, to verify that the
 367    --  files exist and that they belong to a project file.
 368
 369    --  Mains are stored in a table. An index is used to retrieve the mains
 370    --  from the table.
 371
 372    type Main_Info is record
 373       File      : File_Name_Type;  --  Always canonical casing
 374       Index     : Int := 0;
 375       Location  : Source_Ptr := No_Location;
 376
 377       Source    : Prj.Source_Id := No_Source;
 378       Project   : Project_Id;
 379       Tree      : Project_Tree_Ref;
 380    end record;
 381
 382    No_Main_Info : constant Main_Info :=
 383                     (No_File, 0, No_Location, No_Source, No_Project, null);
 384
 385    package Mains is
 386       procedure Add_Main
 387         (Name     : String;
 388          Index    : Int := 0;
 389          Location : Source_Ptr := No_Location;
 390          Project  : Project_Id := No_Project;
 391          Tree     : Project_Tree_Ref := null);
 392       --  Add one main to the table. This is in general used to add the main
 393       --  files specified on the command line. Index is used for multi-unit
 394       --  source files, and indicates which unit in the source is concerned.
 395       --  Location is the location within the project file (if a project file
 396       --  is used). Project and Tree indicate to which project the main should
 397       --  belong. In particular, for aggregate projects, this isn't necessarily
 398       --  the main project tree. These can be set to No_Project and null when
 399       --  not using projects.
 400
 401       procedure Delete;
 402       --  Empty the table
 403
 404       procedure Reset;
 405       --  Reset the cursor to the beginning of the table
 406
 407       procedure Set_Multi_Unit_Index
 408         (Project_Tree : Project_Tree_Ref := null;
 409          Index        : Int := 0);
 410       --  If a single main file was defined, this subprogram indicates which
 411       --  unit inside it is the main (case of a multi-unit source files).
 412       --  Errors are raised if zero or more than one main file was defined,
 413       --  and Index is non-zaero. This subprogram is used for the handling
 414       --  of the command line switch.
 415
 416       function Next_Main return String;
 417       function Next_Main return Main_Info;
 418       --  Moves the cursor forward and returns the new current entry. Returns
 419       --  No_Main_Info there are no more mains in the table.
 420
 421       function Number_Of_Mains (Tree : Project_Tree_Ref) return Natural;
 422       --  Returns the number of mains in this project tree (if Tree is null, it
 423       --  returns the total number of project trees)
 424
 425       procedure Fill_From_Project
 426         (Root_Project : Project_Id;
 427          Project_Tree : Project_Tree_Ref);
 428       --  If no main was already added (presumably from the command line), add
 429       --  the main units from root_project (or in the case of an aggregate
 430       --  project from all the aggregated projects).
 431
 432       procedure Complete_Mains
 433         (Flags        : Processing_Flags;
 434          Root_Project : Project_Id;
 435          Project_Tree : Project_Tree_Ref);
 436       --  If some main units were already added from the command line, check
 437       --  that they all belong to the root project, and that they are full
 438       --  paths rather than (partial) base names (e.g. no body suffix was
 439       --  specified).
 440
 441    end Mains;
 442
 443    -----------
 444    -- Queue --
 445    -----------
 446
 447    type Source_Info_Format is (Format_Gprbuild, Format_Gnatmake);
 448
 449    package Queue is
 450
 451       --  The queue of sources to be checked for compilation. There can be a
 452       --  single such queue per application.
 453
 454       type Source_Info (Format : Source_Info_Format := Format_Gprbuild) is
 455          record
 456             case Format is
 457                when Format_Gprbuild =>
 458                   Tree : Project_Tree_Ref := null;
 459                   Id   : Source_Id        := null;
 460
 461                when Format_Gnatmake =>
 462                   File    : File_Name_Type := No_File;
 463                   Unit    : Unit_Name_Type := No_Unit_Name;
 464                   Index   : Int            := 0;
 465                   Project : Project_Id     := No_Project;
 466             end case;
 467          end record;
 468       --  Information about files stored in the queue. The exact information
 469       --  depends on the builder, and in particular whether it only supports
 470       --  project-based files (in which case we have a full Source_Id record).
 471
 472       No_Source_Info : constant Source_Info := (Format_Gprbuild, null, null);
 473
 474       procedure Initialize
 475         (Queue_Per_Obj_Dir : Boolean;
 476          Force             : Boolean := False);
 477       --  Initialize the queue
 478       --
 479       --  Queue_Per_Obj_Dir matches the --single-compile-per-obj-dir switch:
 480       --  when True, there cannot be simultaneous compilations with the object
 481       --  files in the same object directory when project files are used.
 482       --
 483       --  Nothing is done if Force is False and the queue was already
 484       --  initialized.
 485
 486       procedure Remove_Marks;
 487       --  Remove all marks set for the files. This means that the files will be
 488       --  handed to the compiler if they are added to the queue, and is mostly
 489       --  useful when recompiling several executables in non-project mode, as
 490       --  the switches may be different and -s may be in use.
 491
 492       function Is_Empty return Boolean;
 493       --  Returns True if the queue is empty
 494
 495       function Is_Virtually_Empty return Boolean;
 496       --  Returns True if queue is empty or if all object directories are busy
 497
 498       procedure Insert (Source  : Source_Info; With_Roots : Boolean := False);
 499       function Insert
 500         (Source  : Source_Info; With_Roots : Boolean := False) return Boolean;
 501       --  Insert source in the queue. The second version returns False if the
 502       --  Source was already marked in the queue. If With_Roots is True and the
 503       --  source is in Format_Gprbuild mode (ie with a project), this procedure
 504       --  also includes the "Roots" for this main, ie all the other files that
 505       --  must be included in the library or binary (in particular to combine
 506       --  Ada and C files connected through pragma Export/Import). When the
 507       --  roots are computed, they are also stored in the corresponding
 508       --  Source_Id for later reuse by the binder.
 509
 510       procedure Insert_Project_Sources
 511         (Project        : Project_Id;
 512          Project_Tree   : Project_Tree_Ref;
 513          All_Projects   : Boolean;
 514          Unique_Compile : Boolean);
 515       --  Insert all the compilable sources of the project in the queue. If
 516       --  All_Project is true, then all sources from imported projects are also
 517       --  inserted. Unique_Compile should be true if "-u" was specified on the
 518       --  command line: if True and some files were given on the command line),
 519       --  only those files will be compiled (so Insert_Project_Sources will do
 520       --  nothing). If True and no file was specified on the command line, all
 521       --  files of the project(s) will be compiled. This procedure also
 522       --  processed aggregated projects.
 523
 524       procedure Insert_Withed_Sources_For
 525         (The_ALI               : ALI.ALI_Id;
 526          Project_Tree          : Project_Tree_Ref;
 527          Excluding_Shared_SALs : Boolean := False);
 528       --  Insert in the queue those sources withed by The_ALI, if there are not
 529       --  already in the queue and Only_Interfaces is False or they are part of
 530       --  the interfaces of their project.
 531
 532       procedure Extract
 533         (Found  : out Boolean;
 534          Source : out Source_Info);
 535       --  Get the first source that can be compiled from the queue. If no
 536       --  source may be compiled, sets Found to False. In this case, the value
 537       --  for Source is undefined.
 538
 539       function Size return Natural;
 540       --  Return the total size of the queue, including the sources already
 541       --  extracted.
 542
 543       function Processed return Natural;
 544       --  Return the number of source in the queue that have aready been
 545       --  processed.
 546
 547       procedure Set_Obj_Dir_Busy (Obj_Dir : Path_Name_Type);
 548       procedure Set_Obj_Dir_Free (Obj_Dir : Path_Name_Type);
 549       --  Mark Obj_Dir as busy or free (see the parameter to Initialize)
 550
 551       function Element (Rank : Positive) return File_Name_Type;
 552       --  Get the file name for element of index Rank in the queue
 553
 554    end Queue;
 555
 556 end Makeutl;