OpenCores
URL https://opencores.org/ocsvn/openrisc_2011-10-31/openrisc_2011-10-31/trunk

Subversion Repositories openrisc_2011-10-31

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [ada/] [prj-nmsc.adb] - Blame information for rev 281

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 281 jeremybenn
------------------------------------------------------------------------------
2
--                                                                          --
3
--                         GNAT COMPILER COMPONENTS                         --
4
--                                                                          --
5
--                             P R J . N M S C                              --
6
--                                                                          --
7
--                                 B o d y                                  --
8
--                                                                          --
9
--          Copyright (C) 2000-2009, 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 GNAT.Case_Util;             use GNAT.Case_Util;
27
with GNAT.Directory_Operations;  use GNAT.Directory_Operations;
28
with GNAT.Dynamic_HTables;
29
 
30
with Err_Vars; use Err_Vars;
31
with Opt;      use Opt;
32
with Osint;    use Osint;
33
with Output;   use Output;
34
with Prj.Err;  use Prj.Err;
35
with Prj.Util; use Prj.Util;
36
with Sinput.P;
37
with Snames;   use Snames;
38
with Targparm; use Targparm;
39
 
40
with Ada.Characters.Handling;    use Ada.Characters.Handling;
41
with Ada.Directories;            use Ada.Directories;
42
with Ada.Strings;                use Ada.Strings;
43
with Ada.Strings.Fixed;          use Ada.Strings.Fixed;
44
with Ada.Strings.Maps.Constants; use Ada.Strings.Maps.Constants;
45
 
46
package body Prj.Nmsc is
47
 
48
   No_Continuation_String : aliased String := "";
49
   Continuation_String    : aliased String := "\";
50
   --  Used in Check_Library for continuation error messages at the same
51
   --  location.
52
 
53
   type Name_Location is record
54
      Name     : File_Name_Type;  --  ??? duplicates the key
55
      Location : Source_Ptr;
56
      Source   : Source_Id := No_Source;
57
      Found    : Boolean := False;
58
   end record;
59
   No_Name_Location : constant Name_Location :=
60
     (No_File, No_Location, No_Source, False);
61
   package Source_Names_Htable is new GNAT.Dynamic_HTables.Simple_HTable
62
     (Header_Num => Header_Num,
63
      Element    => Name_Location,
64
      No_Element => No_Name_Location,
65
      Key        => File_Name_Type,
66
      Hash       => Hash,
67
      Equal      => "=");
68
   --  Information about file names found in string list attribute
69
   --  (Source_Files or Source_List_File).
70
   --  Except is set to True if source is a naming exception in the project.
71
   --  This is used to check that all referenced files were indeed found on the
72
   --  disk.
73
 
74
   type Unit_Exception is record
75
      Name : Name_Id;  --  ??? duplicates the key
76
      Spec : File_Name_Type;
77
      Impl : File_Name_Type;
78
   end record;
79
 
80
   No_Unit_Exception : constant Unit_Exception := (No_Name, No_File, No_File);
81
 
82
   package Unit_Exceptions_Htable is new GNAT.Dynamic_HTables.Simple_HTable
83
     (Header_Num => Header_Num,
84
      Element    => Unit_Exception,
85
      No_Element => No_Unit_Exception,
86
      Key        => Name_Id,
87
      Hash       => Hash,
88
      Equal      => "=");
89
   --  Record special naming schemes for Ada units (name of spec file and name
90
   --  of implementation file). The elements in this list come from the naming
91
   --  exceptions specified in the project files.
92
 
93
   type File_Found is record
94
      File     : File_Name_Type  := No_File;
95
      Found    : Boolean         := False;
96
      Location : Source_Ptr      := No_Location;
97
   end record;
98
 
99
   No_File_Found : constant File_Found := (No_File, False, No_Location);
100
 
101
   package Excluded_Sources_Htable is new GNAT.Dynamic_HTables.Simple_HTable
102
     (Header_Num => Header_Num,
103
      Element    => File_Found,
104
      No_Element => No_File_Found,
105
      Key        => File_Name_Type,
106
      Hash       => Hash,
107
      Equal      => "=");
108
   --  A hash table to store the base names of excluded files, if any
109
 
110
   package Object_File_Names_Htable is new GNAT.Dynamic_HTables.Simple_HTable
111
     (Header_Num => Header_Num,
112
      Element    => Source_Id,
113
      No_Element => No_Source,
114
      Key        => File_Name_Type,
115
      Hash       => Hash,
116
      Equal      => "=");
117
   --  A hash table to store the object file names for a project, to check that
118
   --  two different sources have different object file names.
119
 
120
   type Project_Processing_Data is record
121
      Project         : Project_Id;
122
      Source_Names    : Source_Names_Htable.Instance;
123
      Unit_Exceptions : Unit_Exceptions_Htable.Instance;
124
      Excluded        : Excluded_Sources_Htable.Instance;
125
 
126
      Source_List_File_Location : Source_Ptr;
127
      --  Location of the Source_List_File attribute, for error messages
128
   end record;
129
   --  This is similar to Tree_Processing_Data, but contains project-specific
130
   --  information which is only useful while processing the project, and can
131
   --  be discarded as soon as we have finished processing the project
132
 
133
   package Files_Htable is new GNAT.Dynamic_HTables.Simple_HTable
134
     (Header_Num => Header_Num,
135
      Element    => Source_Id,
136
      No_Element => No_Source,
137
      Key        => File_Name_Type,
138
      Hash       => Hash,
139
      Equal      => "=");
140
   --  Mapping from base file names to Source_Id (containing full info about
141
   --  the source).
142
 
143
   type Tree_Processing_Data is record
144
      Tree           : Project_Tree_Ref;
145
      File_To_Source : Files_Htable.Instance;
146
      Flags          : Prj.Processing_Flags;
147
   end record;
148
   --  Temporary data which is needed while parsing a project. It does not need
149
   --  to be kept in memory once a project has been fully loaded, but is
150
   --  necessary while performing consistency checks (duplicate sources,...)
151
   --  This data must be initialized before processing any project, and the
152
   --  same data is used for processing all projects in the tree.
153
 
154
   procedure Initialize
155
     (Data  : out Tree_Processing_Data;
156
      Tree  : Project_Tree_Ref;
157
      Flags : Prj.Processing_Flags);
158
   --  Initialize Data
159
 
160
   procedure Free (Data : in out Tree_Processing_Data);
161
   --  Free the memory occupied by Data
162
 
163
   procedure Check
164
     (Project     : Project_Id;
165
      Data        : in out Tree_Processing_Data);
166
   --  Process the naming scheme for a single project
167
 
168
   procedure Initialize
169
     (Data    : in out Project_Processing_Data;
170
      Project : Project_Id);
171
   procedure Free (Data : in out Project_Processing_Data);
172
   --  Initialize or free memory for a project-specific data
173
 
174
   procedure Find_Excluded_Sources
175
     (Project : in out Project_Processing_Data;
176
      Data    : in out Tree_Processing_Data);
177
   --  Find the list of files that should not be considered as source files
178
   --  for this project. Sets the list in the Project.Excluded_Sources_Htable.
179
 
180
   procedure Override_Kind (Source : Source_Id; Kind : Source_Kind);
181
   --  Override the reference kind for a source file. This properly updates
182
   --  the unit data if necessary.
183
 
184
   procedure Load_Naming_Exceptions
185
     (Project : in out Project_Processing_Data;
186
      Data    : in out Tree_Processing_Data);
187
   --  All source files in Data.First_Source are considered as naming
188
   --  exceptions, and copied into the Source_Names and Unit_Exceptions tables
189
   --  as appropriate.
190
 
191
   procedure Add_Source
192
     (Id                  : out Source_Id;
193
      Data                : in out Tree_Processing_Data;
194
      Project             : Project_Id;
195
      Source_Dir_Rank     : Natural;
196
      Lang_Id             : Language_Ptr;
197
      Kind                : Source_Kind;
198
      File_Name           : File_Name_Type;
199
      Display_File        : File_Name_Type;
200
      Naming_Exception    : Boolean          := False;
201
      Path                : Path_Information := No_Path_Information;
202
      Alternate_Languages : Language_List    := null;
203
      Unit                : Name_Id          := No_Name;
204
      Index               : Int              := 0;
205
      Locally_Removed     : Boolean          := False;
206
      Location            : Source_Ptr       := No_Location);
207
   --  Add a new source to the different lists: list of all sources in the
208
   --  project tree, list of source of a project and list of sources of a
209
   --  language.
210
   --
211
   --  If Path is specified, the file is also added to Source_Paths_HT.
212
   --
213
   --  Location is used for error messages
214
 
215
   function Canonical_Case_File_Name (Name : Name_Id) return File_Name_Type;
216
   --  Same as Osint.Canonical_Case_File_Name but applies to Name_Id.
217
   --  This alters Name_Buffer
218
 
219
   function Suffix_Matches
220
     (Filename : String;
221
      Suffix   : File_Name_Type) return Boolean;
222
   --  True if the file name ends with the given suffix. Always returns False
223
   --  if Suffix is No_Name.
224
 
225
   procedure Replace_Into_Name_Buffer
226
     (Str         : String;
227
      Pattern     : String;
228
      Replacement : Character);
229
   --  Copy Str into Name_Buffer, replacing Pattern with Replacement. Str is
230
   --  converted to lower-case at the same time.
231
 
232
   procedure Check_Ada_Name (Name : String; Unit : out Name_Id);
233
   --  Check that a name is a valid Ada unit name
234
 
235
   procedure Check_Package_Naming
236
     (Project : Project_Id;
237
      Data    : in out Tree_Processing_Data;
238
      Bodies  : out Array_Element_Id;
239
      Specs   : out Array_Element_Id);
240
   --  Check the naming scheme part of Data, and initialize the naming scheme
241
   --  data in the config of the various languages. This also returns the
242
   --  naming scheme exceptions for unit-based languages (Bodies and Specs are
243
   --  associative arrays mapping individual unit names to source file names).
244
 
245
   procedure Check_Configuration
246
     (Project : Project_Id;
247
      Data    : in out Tree_Processing_Data);
248
   --  Check the configuration attributes for the project
249
 
250
   procedure Check_If_Externally_Built
251
     (Project : Project_Id;
252
      Data    : in out Tree_Processing_Data);
253
   --  Check attribute Externally_Built of project Project in project tree
254
   --  Data.Tree and modify its data Data if it has the value "true".
255
 
256
   procedure Check_Interfaces
257
     (Project : Project_Id;
258
      Data    : in out Tree_Processing_Data);
259
   --  If a list of sources is specified in attribute Interfaces, set
260
   --  In_Interfaces only for the sources specified in the list.
261
 
262
   procedure Check_Library_Attributes
263
     (Project : Project_Id;
264
      Data    : in out Tree_Processing_Data);
265
   --  Check the library attributes of project Project in project tree
266
   --  and modify its data Data accordingly.
267
 
268
   procedure Check_Programming_Languages
269
     (Project : Project_Id;
270
      Data    : in out Tree_Processing_Data);
271
   --  Check attribute Languages for the project with data Data in project
272
   --  tree Data.Tree and set the components of Data for all the programming
273
   --  languages indicated in attribute Languages, if any.
274
 
275
   procedure Check_Stand_Alone_Library
276
     (Project : Project_Id;
277
      Data    : in out Tree_Processing_Data);
278
   --  Check if project Project in project tree Data.Tree is a Stand-Alone
279
   --  Library project, and modify its data Data accordingly if it is one.
280
 
281
   function Compute_Directory_Last (Dir : String) return Natural;
282
   --  Return the index of the last significant character in Dir. This is used
283
   --  to avoid duplicate '/' (slash) characters at the end of directory names.
284
 
285
   procedure Search_Directories
286
     (Project         : in out Project_Processing_Data;
287
      Data            : in out Tree_Processing_Data;
288
      For_All_Sources : Boolean);
289
   --  Search the source directories to find the sources. If For_All_Sources is
290
   --  True, check each regular file name against the naming schemes of the
291
   --  various languages. Otherwise consider only the file names in hash table
292
   --  Source_Names. If Allow_Duplicate_Basenames then files with identical
293
   --  base names are permitted within a project for source-based languages
294
   --  (never for unit based languages).
295
 
296
   procedure Check_File
297
     (Project           : in out Project_Processing_Data;
298
      Data              : in out Tree_Processing_Data;
299
      Source_Dir_Rank   : Natural;
300
      Path              : Path_Name_Type;
301
      File_Name         : File_Name_Type;
302
      Display_File_Name : File_Name_Type;
303
      Locally_Removed   : Boolean;
304
      For_All_Sources   : Boolean);
305
   --  Check if file File_Name is a valid source of the project. This is used
306
   --  in multi-language mode only. When the file matches one of the naming
307
   --  schemes, it is added to various htables through Add_Source and to
308
   --  Source_Paths_Htable.
309
   --
310
   --  Name is the name of the candidate file. It hasn't been normalized yet
311
   --  and is the direct result of readdir().
312
   --
313
   --  File_Name is the same as Name, but has been normalized.
314
   --  Display_File_Name, however, has not been normalized.
315
   --
316
   --  Source_Directory is the directory in which the file was found. It is
317
   --  neither normalized nor has had links resolved, and must not end with a
318
   --  a directory separator, to avoid duplicates later on.
319
   --
320
   --  If For_All_Sources is True, then all possible file names are analyzed
321
   --  otherwise only those currently set in the Source_Names hash table.
322
 
323
   procedure Check_File_Naming_Schemes
324
     (In_Tree               : Project_Tree_Ref;
325
      Project               : Project_Processing_Data;
326
      File_Name             : File_Name_Type;
327
      Alternate_Languages   : out Language_List;
328
      Language              : out Language_Ptr;
329
      Display_Language_Name : out Name_Id;
330
      Unit                  : out Name_Id;
331
      Lang_Kind             : out Language_Kind;
332
      Kind                  : out Source_Kind);
333
   --  Check if the file name File_Name conforms to one of the naming schemes
334
   --  of the project. If the file does not match one of the naming schemes,
335
   --  set Language to No_Language_Index. Filename is the name of the file
336
   --  being investigated. It has been normalized (case-folded). File_Name is
337
   --  the same value.
338
 
339
   procedure Get_Directories
340
     (Project     : Project_Id;
341
      Data        : in out Tree_Processing_Data);
342
   --  Get the object directory, the exec directory and the source directories
343
   --  of a project.
344
 
345
   procedure Get_Mains
346
     (Project : Project_Id;
347
      Data    : in out Tree_Processing_Data);
348
   --  Get the mains of a project from attribute Main, if it exists, and put
349
   --  them in the project data.
350
 
351
   procedure Get_Sources_From_File
352
     (Path     : String;
353
      Location : Source_Ptr;
354
      Project  : in out Project_Processing_Data;
355
      Data     : in out Tree_Processing_Data);
356
   --  Get the list of sources from a text file and put them in hash table
357
   --  Source_Names.
358
 
359
   procedure Find_Sources
360
     (Project : in out Project_Processing_Data;
361
      Data    : in out Tree_Processing_Data);
362
   --  Process the Source_Files and Source_List_File attributes, and store the
363
   --  list of source files into the Source_Names htable. When these attributes
364
   --  are not defined, find all files matching the naming schemes in the
365
   --  source directories. If Allow_Duplicate_Basenames, then files with the
366
   --  same base names are authorized within a project for source-based
367
   --  languages (never for unit based languages)
368
 
369
   procedure Compute_Unit_Name
370
     (File_Name : File_Name_Type;
371
      Naming    : Lang_Naming_Data;
372
      Kind      : out Source_Kind;
373
      Unit      : out Name_Id;
374
      Project   : Project_Processing_Data;
375
      In_Tree   : Project_Tree_Ref);
376
   --  Check whether the file matches the naming scheme. If it does,
377
   --  compute its unit name. If Unit is set to No_Name on exit, none of the
378
   --  other out parameters are relevant.
379
 
380
   procedure Check_Illegal_Suffix
381
     (Project         : Project_Id;
382
      Suffix          : File_Name_Type;
383
      Dot_Replacement : File_Name_Type;
384
      Attribute_Name  : String;
385
      Location        : Source_Ptr;
386
      Data            : in out Tree_Processing_Data);
387
   --  Display an error message if the given suffix is illegal for some reason.
388
   --  The name of the attribute we are testing is specified in Attribute_Name,
389
   --  which is used in the error message. Location is the location where the
390
   --  suffix is defined.
391
 
392
   procedure Locate_Directory
393
     (Project          : Project_Id;
394
      Name             : File_Name_Type;
395
      Path             : out Path_Information;
396
      Dir_Exists       : out Boolean;
397
      Data             : in out Tree_Processing_Data;
398
      Create           : String := "";
399
      Location         : Source_Ptr := No_Location;
400
      Must_Exist       : Boolean := True;
401
      Externally_Built : Boolean := False);
402
   --  Locate a directory. Name is the directory name. Relative paths are
403
   --  resolved relative to the project's directory. If the directory does not
404
   --  exist and Setup_Projects is True and Create is a non null string, an
405
   --  attempt is made to create the directory. If the directory does not
406
   --  exist, it is either created if Setup_Projects is False (and then
407
   --  returned), or simply returned without checking for its existence (if
408
   --  Must_Exist is False) or No_Path_Information is returned. In all cases,
409
   --  Dir_Exists indicates whether the directory now exists. Create is also
410
   --  used for debugging traces to show which path we are computing.
411
 
412
   procedure Look_For_Sources
413
     (Project : in out Project_Processing_Data;
414
      Data    : in out Tree_Processing_Data);
415
   --  Find all the sources of project Project in project tree Data.Tree and
416
   --  update its Data accordingly. This assumes that Data.First_Source has
417
   --  been initialized with the list of excluded sources and special naming
418
   --  exceptions.
419
 
420
   function Path_Name_Of
421
     (File_Name : File_Name_Type;
422
      Directory : Path_Name_Type) return String;
423
   --  Returns the path name of a (non project) file. Returns an empty string
424
   --  if file cannot be found.
425
 
426
   procedure Remove_Source
427
     (Id          : Source_Id;
428
      Replaced_By : Source_Id);
429
   --  Remove a file from the list of sources of a project. This might be
430
   --  because the file is replaced by another one in an extending project,
431
   --  or because a file was added as a naming exception but was not found
432
   --  in the end.
433
 
434
   procedure Report_No_Sources
435
     (Project      : Project_Id;
436
      Lang_Name    : String;
437
      Data         : Tree_Processing_Data;
438
      Location     : Source_Ptr;
439
      Continuation : Boolean := False);
440
   --  Report an error or a warning depending on the value of When_No_Sources
441
   --  when there are no sources for language Lang_Name.
442
 
443
   procedure Show_Source_Dirs
444
     (Project : Project_Id; In_Tree : Project_Tree_Ref);
445
   --  List all the source directories of a project
446
 
447
   procedure Write_Attr (Name, Value : String);
448
   --  Debug print a value for a specific property. Does nothing when not in
449
   --  debug mode
450
 
451
   ------------------------------
452
   -- Replace_Into_Name_Buffer --
453
   ------------------------------
454
 
455
   procedure Replace_Into_Name_Buffer
456
     (Str         : String;
457
      Pattern     : String;
458
      Replacement : Character)
459
   is
460
      Max : constant Integer := Str'Last - Pattern'Length + 1;
461
      J   : Positive;
462
 
463
   begin
464
      Name_Len := 0;
465
 
466
      J := Str'First;
467
      while J <= Str'Last loop
468
         Name_Len := Name_Len + 1;
469
 
470
         if J <= Max
471
           and then Str (J .. J + Pattern'Length - 1) = Pattern
472
         then
473
            Name_Buffer (Name_Len) := Replacement;
474
            J := J + Pattern'Length;
475
 
476
         else
477
            Name_Buffer (Name_Len) := GNAT.Case_Util.To_Lower (Str (J));
478
            J := J + 1;
479
         end if;
480
      end loop;
481
   end Replace_Into_Name_Buffer;
482
 
483
   --------------------
484
   -- Suffix_Matches --
485
   --------------------
486
 
487
   function Suffix_Matches
488
     (Filename : String;
489
      Suffix   : File_Name_Type) return Boolean
490
   is
491
      Min_Prefix_Length : Natural := 0;
492
 
493
   begin
494
      if Suffix = No_File or else Suffix = Empty_File then
495
         return False;
496
      end if;
497
 
498
      declare
499
         Suf : String := Get_Name_String (Suffix);
500
 
501
      begin
502
         --  On non case-sensitive systems, use proper suffix casing
503
 
504
         Canonical_Case_File_Name (Suf);
505
 
506
         --  The file name must end with the suffix (which is not an extension)
507
         --  For instance a suffix "configure.in" must match a file with the
508
         --  same name. To avoid dummy cases, though, a suffix starting with
509
         --  '.' requires a file that is at least one character longer ('.cpp'
510
         --  should not match a file with the same name)
511
 
512
         if Suf (Suf'First) = '.' then
513
            Min_Prefix_Length := 1;
514
         end if;
515
 
516
         return Filename'Length >= Suf'Length + Min_Prefix_Length
517
           and then Filename
518
             (Filename'Last - Suf'Length + 1 .. Filename'Last) = Suf;
519
      end;
520
   end Suffix_Matches;
521
 
522
   ----------------
523
   -- Write_Attr --
524
   ----------------
525
 
526
   procedure Write_Attr (Name, Value : String) is
527
   begin
528
      if Current_Verbosity = High then
529
         Write_Str  ("  " & Name & " = """);
530
         Write_Str  (Value);
531
         Write_Char ('"');
532
         Write_Eol;
533
      end if;
534
   end Write_Attr;
535
 
536
   ----------------
537
   -- Add_Source --
538
   ----------------
539
 
540
   procedure Add_Source
541
     (Id                  : out Source_Id;
542
      Data                : in out Tree_Processing_Data;
543
      Project             : Project_Id;
544
      Source_Dir_Rank     : Natural;
545
      Lang_Id             : Language_Ptr;
546
      Kind                : Source_Kind;
547
      File_Name           : File_Name_Type;
548
      Display_File        : File_Name_Type;
549
      Naming_Exception    : Boolean          := False;
550
      Path                : Path_Information := No_Path_Information;
551
      Alternate_Languages : Language_List    := null;
552
      Unit                : Name_Id          := No_Name;
553
      Index               : Int              := 0;
554
      Locally_Removed     : Boolean          := False;
555
      Location            : Source_Ptr       := No_Location)
556
   is
557
      Config    : constant Language_Config := Lang_Id.Config;
558
      UData     : Unit_Index;
559
      Add_Src   : Boolean;
560
      Source    : Source_Id;
561
      Prev_Unit : Unit_Index := No_Unit_Index;
562
 
563
      Source_To_Replace : Source_Id := No_Source;
564
 
565
   begin
566
      --  Check if the same file name or unit is used in the prj tree
567
 
568
      Add_Src := True;
569
 
570
      if Unit /= No_Name then
571
         Prev_Unit := Units_Htable.Get (Data.Tree.Units_HT, Unit);
572
      end if;
573
 
574
      if Prev_Unit /= No_Unit_Index
575
        and then (Kind = Impl or else Kind = Spec)
576
        and then Prev_Unit.File_Names (Kind) /= null
577
      then
578
         --  Suspicious, we need to check later whether this is authorized
579
 
580
         Add_Src := False;
581
         Source := Prev_Unit.File_Names (Kind);
582
 
583
      else
584
         Source  := Files_Htable.Get (Data.File_To_Source, File_Name);
585
 
586
         if Source /= No_Source
587
           and then Source.Index = Index
588
         then
589
            Add_Src := False;
590
         end if;
591
      end if;
592
 
593
      --  Duplication of file/unit in same project is allowed if order of
594
      --  source directories is known.
595
 
596
      if Add_Src = False then
597
         Add_Src := True;
598
 
599
         if Project = Source.Project then
600
            if Prev_Unit = No_Unit_Index then
601
               if Data.Flags.Allow_Duplicate_Basenames then
602
                  Add_Src := True;
603
 
604
               elsif Source_Dir_Rank /= Source.Source_Dir_Rank then
605
                  Add_Src := False;
606
 
607
               else
608
                  Error_Msg_File_1 := File_Name;
609
                  Error_Msg
610
                    (Data.Flags, "duplicate source file name {",
611
                     Location, Project);
612
                  Add_Src := False;
613
               end if;
614
 
615
            else
616
               if Source_Dir_Rank /= Source.Source_Dir_Rank then
617
                  Add_Src := False;
618
 
619
               --  We might be seeing the same file through a different path
620
               --  (for instance because of symbolic links).
621
 
622
               elsif Source.Path.Name /= Path.Name then
623
                  Error_Msg_Name_1 := Unit;
624
                  Error_Msg
625
                    (Data.Flags, "duplicate unit %%", Location, Project);
626
                  Add_Src := False;
627
               end if;
628
            end if;
629
 
630
            --  Do not allow the same unit name in different projects, except
631
            --  if one is extending the other.
632
 
633
            --  For a file based language, the same file name replaces a file
634
            --  in a project being extended, but it is allowed to have the same
635
            --  file name in unrelated projects.
636
 
637
         elsif Is_Extending (Project, Source.Project) then
638
            if not Locally_Removed then
639
               Source_To_Replace := Source;
640
            end if;
641
 
642
         elsif Prev_Unit /= No_Unit_Index
643
           and then not Source.Locally_Removed
644
         then
645
            --  Path is set if this is a source we found on the disk, in which
646
            --  case we can provide more explicit error message. Path is unset
647
            --  when the source is added from one of the naming exceptions in
648
            --  the project.
649
 
650
            if Path /= No_Path_Information then
651
               Error_Msg_Name_1 := Unit;
652
               Error_Msg
653
                 (Data.Flags,
654
                  "unit %% cannot belong to several projects",
655
                  Location, Project);
656
 
657
               Error_Msg_Name_1 := Project.Name;
658
               Error_Msg_Name_2 := Name_Id (Path.Display_Name);
659
               Error_Msg
660
                 (Data.Flags, "\  project %%, %%", Location, Project);
661
 
662
               Error_Msg_Name_1 := Source.Project.Name;
663
               Error_Msg_Name_2 := Name_Id (Source.Path.Display_Name);
664
               Error_Msg
665
                 (Data.Flags, "\  project %%, %%", Location, Project);
666
 
667
            else
668
               Error_Msg_Name_1 := Unit;
669
               Error_Msg_Name_2 := Source.Project.Name;
670
               Error_Msg
671
                 (Data.Flags, "unit %% already belongs to project %%",
672
                  Location, Project);
673
            end if;
674
 
675
            Add_Src := False;
676
 
677
         elsif not Source.Locally_Removed
678
           and then not Data.Flags.Allow_Duplicate_Basenames
679
           and then Lang_Id.Config.Kind = Unit_Based
680
         then
681
            Error_Msg_File_1 := File_Name;
682
            Error_Msg_File_2 := File_Name_Type (Source.Project.Name);
683
            Error_Msg
684
              (Data.Flags,
685
               "{ is already a source of project {", Location, Project);
686
 
687
            --  Add the file anyway, to avoid further warnings like "language
688
            --  unknown".
689
 
690
            Add_Src := True;
691
         end if;
692
      end if;
693
 
694
      if not Add_Src then
695
         return;
696
      end if;
697
 
698
      --  Add the new file
699
 
700
      Id := new Source_Data;
701
 
702
      if Current_Verbosity = High then
703
         Write_Str ("Adding source File: ");
704
         Write_Str (Get_Name_String (File_Name));
705
 
706
         if Index /= 0 then
707
            Write_Str (" at" & Index'Img);
708
         end if;
709
 
710
         if Lang_Id.Config.Kind = Unit_Based then
711
            Write_Str (" Unit: ");
712
 
713
            --  ??? in gprclean, it seems we sometimes pass an empty Unit name
714
            --  (see test extended_projects).
715
 
716
            if Unit /= No_Name then
717
               Write_Str (Get_Name_String (Unit));
718
            end if;
719
 
720
            Write_Str (" Kind: ");
721
            Write_Str (Source_Kind'Image (Kind));
722
         end if;
723
 
724
         Write_Eol;
725
      end if;
726
 
727
      Id.Project             := Project;
728
      Id.Source_Dir_Rank     := Source_Dir_Rank;
729
      Id.Language            := Lang_Id;
730
      Id.Kind                := Kind;
731
      Id.Alternate_Languages := Alternate_Languages;
732
      Id.Locally_Removed     := Locally_Removed;
733
      Id.Index               := Index;
734
      Id.File                := File_Name;
735
      Id.Display_File        := Display_File;
736
      Id.Dep_Name            := Dependency_Name
737
                                  (File_Name, Lang_Id.Config.Dependency_Kind);
738
      Id.Naming_Exception    := Naming_Exception;
739
 
740
      --  Add the source id to the Unit_Sources_HT hash table, if the unit name
741
      --  is not null.
742
 
743
      if Unit /= No_Name then
744
 
745
         --  Note: we might be creating a dummy unit here, when we in fact have
746
         --  a separate. For instance, file file-bar.adb will initially be
747
         --  assumed to be the IMPL of unit "file.bar". Only later on (in
748
         --  Check_Object_Files) will we parse those units that only have an
749
         --  impl and no spec to make sure whether we have a Separate in fact
750
         --  (that significantly reduces the number of times we need to parse
751
         --  the files, since we are then only interested in those with no
752
         --  spec). We still need those dummy units in the table, since that's
753
         --  the name we find in the ALI file
754
 
755
         UData := Units_Htable.Get (Data.Tree.Units_HT, Unit);
756
 
757
         if UData = No_Unit_Index then
758
            UData := new Unit_Data;
759
            UData.Name := Unit;
760
            Units_Htable.Set (Data.Tree.Units_HT, Unit, UData);
761
         end if;
762
 
763
         Id.Unit := UData;
764
 
765
         --  Note that this updates Unit information as well
766
 
767
         Override_Kind (Id, Kind);
768
      end if;
769
 
770
      if Is_Compilable (Id) and then Config.Object_Generated then
771
         Id.Object   := Object_Name (File_Name, Config.Object_File_Suffix);
772
         Id.Switches := Switches_Name (File_Name);
773
      end if;
774
 
775
      if Path /= No_Path_Information then
776
         Id.Path := Path;
777
         Source_Paths_Htable.Set (Data.Tree.Source_Paths_HT, Path.Name, Id);
778
      end if;
779
 
780
      if Index /= 0 then
781
         Project.Has_Multi_Unit_Sources := True;
782
      end if;
783
 
784
      --  Add the source to the language list
785
 
786
      Id.Next_In_Lang := Lang_Id.First_Source;
787
      Lang_Id.First_Source := Id;
788
 
789
      if Source_To_Replace /= No_Source then
790
         Remove_Source (Source_To_Replace, Id);
791
      end if;
792
 
793
      Files_Htable.Set (Data.File_To_Source, File_Name, Id);
794
   end Add_Source;
795
 
796
   ------------------------------
797
   -- Canonical_Case_File_Name --
798
   ------------------------------
799
 
800
   function Canonical_Case_File_Name (Name : Name_Id) return File_Name_Type is
801
   begin
802
      if Osint.File_Names_Case_Sensitive then
803
         return File_Name_Type (Name);
804
      else
805
         Get_Name_String (Name);
806
         Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
807
         return Name_Find;
808
      end if;
809
   end Canonical_Case_File_Name;
810
 
811
   -----------
812
   -- Check --
813
   -----------
814
 
815
   procedure Check
816
     (Project     : Project_Id;
817
      Data        : in out Tree_Processing_Data)
818
   is
819
      Specs     : Array_Element_Id;
820
      Bodies    : Array_Element_Id;
821
      Extending : Boolean := False;
822
      Prj_Data  : Project_Processing_Data;
823
 
824
   begin
825
      Initialize (Prj_Data, Project);
826
 
827
      Check_If_Externally_Built (Project, Data);
828
 
829
      --  Object, exec and source directories
830
 
831
      Get_Directories (Project, Data);
832
 
833
      --  Get the programming languages
834
 
835
      Check_Programming_Languages (Project, Data);
836
 
837
      if Project.Qualifier = Dry
838
        and then Project.Source_Dirs /= Nil_String
839
      then
840
         declare
841
            Source_Dirs      : constant Variable_Value :=
842
                                 Util.Value_Of
843
                                   (Name_Source_Dirs,
844
                                    Project.Decl.Attributes, Data.Tree);
845
            Source_Files     : constant Variable_Value :=
846
                                 Util.Value_Of
847
                                   (Name_Source_Files,
848
                                    Project.Decl.Attributes, Data.Tree);
849
            Source_List_File : constant Variable_Value :=
850
                                 Util.Value_Of
851
                                   (Name_Source_List_File,
852
                                    Project.Decl.Attributes, Data.Tree);
853
            Languages        : constant Variable_Value :=
854
                                 Util.Value_Of
855
                                   (Name_Languages,
856
                                    Project.Decl.Attributes, Data.Tree);
857
 
858
         begin
859
            if Source_Dirs.Values  = Nil_String
860
              and then Source_Files.Values = Nil_String
861
              and then Languages.Values = Nil_String
862
              and then Source_List_File.Default
863
            then
864
               Project.Source_Dirs := Nil_String;
865
 
866
            else
867
               Error_Msg
868
                 (Data.Flags,
869
                  "at least one of Source_Files, Source_Dirs or Languages "
870
                    & "must be declared empty for an abstract project",
871
                  Project.Location, Project);
872
            end if;
873
         end;
874
      end if;
875
 
876
      --  Check configuration. This must be done even for gnatmake (even though
877
      --  no user configuration file was provided) since the default config we
878
      --  generate indicates whether libraries are supported for instance.
879
 
880
      Check_Configuration (Project, Data);
881
 
882
      --  Library attributes
883
 
884
      Check_Library_Attributes (Project, Data);
885
 
886
      if Current_Verbosity = High then
887
         Show_Source_Dirs (Project, Data.Tree);
888
      end if;
889
 
890
      Extending := Project.Extends /= No_Project;
891
 
892
      Check_Package_Naming (Project, Data, Bodies => Bodies, Specs => Specs);
893
 
894
      --  Find the sources
895
 
896
      if Project.Source_Dirs /= Nil_String then
897
         Look_For_Sources (Prj_Data, Data);
898
 
899
         if not Project.Externally_Built
900
           and then not Extending
901
         then
902
            declare
903
               Language     : Language_Ptr;
904
               Source       : Source_Id;
905
               Alt_Lang     : Language_List;
906
               Continuation : Boolean := False;
907
               Iter         : Source_Iterator;
908
 
909
            begin
910
               Language := Project.Languages;
911
               while Language /= No_Language_Index loop
912
 
913
                  --  If there are no sources for this language, check if there
914
                  --  are sources for which this is an alternate language.
915
 
916
                  if Language.First_Source = No_Source
917
                    and then (Data.Flags.Require_Sources_Other_Lang
918
                               or else Language.Name = Name_Ada)
919
                  then
920
                     Iter := For_Each_Source (In_Tree => Data.Tree,
921
                                              Project => Project);
922
                     Source_Loop : loop
923
                        Source := Element (Iter);
924
                        exit Source_Loop when Source = No_Source
925
                          or else Source.Language = Language;
926
 
927
                        Alt_Lang := Source.Alternate_Languages;
928
                        while Alt_Lang /= null loop
929
                           exit Source_Loop when Alt_Lang.Language = Language;
930
                           Alt_Lang := Alt_Lang.Next;
931
                        end loop;
932
 
933
                        Next (Iter);
934
                     end loop Source_Loop;
935
 
936
                     if Source = No_Source then
937
 
938
                        Report_No_Sources
939
                          (Project,
940
                           Get_Name_String (Language.Display_Name),
941
                           Data,
942
                           Prj_Data.Source_List_File_Location,
943
                           Continuation);
944
                        Continuation := True;
945
                     end if;
946
                  end if;
947
 
948
                  Language := Language.Next;
949
               end loop;
950
            end;
951
         end if;
952
      end if;
953
 
954
      --  If a list of sources is specified in attribute Interfaces, set
955
      --  In_Interfaces only for the sources specified in the list.
956
 
957
      Check_Interfaces (Project, Data);
958
 
959
      --  If it is a library project file, check if it is a standalone library
960
 
961
      if Project.Library then
962
         Check_Stand_Alone_Library (Project, Data);
963
      end if;
964
 
965
      --  Put the list of Mains, if any, in the project data
966
 
967
      Get_Mains (Project, Data);
968
 
969
      Free (Prj_Data);
970
   end Check;
971
 
972
   --------------------
973
   -- Check_Ada_Name --
974
   --------------------
975
 
976
   procedure Check_Ada_Name (Name : String; Unit : out Name_Id) is
977
      The_Name        : String := Name;
978
      Real_Name       : Name_Id;
979
      Need_Letter     : Boolean := True;
980
      Last_Underscore : Boolean := False;
981
      OK              : Boolean := The_Name'Length > 0;
982
      First           : Positive;
983
 
984
      function Is_Reserved (Name : Name_Id) return Boolean;
985
      function Is_Reserved (S    : String)  return Boolean;
986
      --  Check that the given name is not an Ada 95 reserved word. The reason
987
      --  for the Ada 95 here is that we do not want to exclude the case of an
988
      --  Ada 95 unit called Interface (for example). In Ada 2005, such a unit
989
      --  name would be rejected anyway by the compiler. That means there is no
990
      --  requirement that the project file parser reject this.
991
 
992
      -----------------
993
      -- Is_Reserved --
994
      -----------------
995
 
996
      function Is_Reserved (S : String) return Boolean is
997
      begin
998
         Name_Len := 0;
999
         Add_Str_To_Name_Buffer (S);
1000
         return Is_Reserved (Name_Find);
1001
      end Is_Reserved;
1002
 
1003
      -----------------
1004
      -- Is_Reserved --
1005
      -----------------
1006
 
1007
      function Is_Reserved (Name : Name_Id) return Boolean is
1008
      begin
1009
         if Get_Name_Table_Byte (Name) /= 0
1010
           and then Name /= Name_Project
1011
           and then Name /= Name_Extends
1012
           and then Name /= Name_External
1013
           and then Name not in Ada_2005_Reserved_Words
1014
         then
1015
            Unit := No_Name;
1016
 
1017
            if Current_Verbosity = High then
1018
               Write_Str (The_Name);
1019
               Write_Line (" is an Ada reserved word.");
1020
            end if;
1021
 
1022
            return True;
1023
 
1024
         else
1025
            return False;
1026
         end if;
1027
      end Is_Reserved;
1028
 
1029
   --  Start of processing for Check_Ada_Name
1030
 
1031
   begin
1032
      To_Lower (The_Name);
1033
 
1034
      Name_Len := The_Name'Length;
1035
      Name_Buffer (1 .. Name_Len) := The_Name;
1036
 
1037
      --  Special cases of children of packages A, G, I and S on VMS
1038
 
1039
      if OpenVMS_On_Target
1040
        and then Name_Len > 3
1041
        and then Name_Buffer (2 .. 3) = "__"
1042
        and then
1043
          ((Name_Buffer (1) = 'a') or else
1044
           (Name_Buffer (1) = 'g') or else
1045
           (Name_Buffer (1) = 'i') or else
1046
           (Name_Buffer (1) = 's'))
1047
      then
1048
         Name_Buffer (2) := '.';
1049
         Name_Buffer (3 .. Name_Len - 1) := Name_Buffer (4 .. Name_Len);
1050
         Name_Len := Name_Len - 1;
1051
      end if;
1052
 
1053
      Real_Name := Name_Find;
1054
 
1055
      if Is_Reserved (Real_Name) then
1056
         return;
1057
      end if;
1058
 
1059
      First := The_Name'First;
1060
 
1061
      for Index in The_Name'Range loop
1062
         if Need_Letter then
1063
 
1064
            --  We need a letter (at the beginning, and following a dot),
1065
            --  but we don't have one.
1066
 
1067
            if Is_Letter (The_Name (Index)) then
1068
               Need_Letter := False;
1069
 
1070
            else
1071
               OK := False;
1072
 
1073
               if Current_Verbosity = High then
1074
                  Write_Int  (Types.Int (Index));
1075
                  Write_Str  (": '");
1076
                  Write_Char (The_Name (Index));
1077
                  Write_Line ("' is not a letter.");
1078
               end if;
1079
 
1080
               exit;
1081
            end if;
1082
 
1083
         elsif Last_Underscore
1084
           and then (The_Name (Index) = '_' or else The_Name (Index) = '.')
1085
         then
1086
            --  Two underscores are illegal, and a dot cannot follow
1087
            --  an underscore.
1088
 
1089
            OK := False;
1090
 
1091
            if Current_Verbosity = High then
1092
               Write_Int  (Types.Int (Index));
1093
               Write_Str  (": '");
1094
               Write_Char (The_Name (Index));
1095
               Write_Line ("' is illegal here.");
1096
            end if;
1097
 
1098
            exit;
1099
 
1100
         elsif The_Name (Index) = '.' then
1101
 
1102
            --  First, check if the name before the dot is not a reserved word
1103
 
1104
            if Is_Reserved (The_Name (First .. Index - 1)) then
1105
               return;
1106
            end if;
1107
 
1108
            First := Index + 1;
1109
 
1110
            --  We need a letter after a dot
1111
 
1112
            Need_Letter := True;
1113
 
1114
         elsif The_Name (Index) = '_' then
1115
            Last_Underscore := True;
1116
 
1117
         else
1118
            --  We need an letter or a digit
1119
 
1120
            Last_Underscore := False;
1121
 
1122
            if not Is_Alphanumeric (The_Name (Index)) then
1123
               OK := False;
1124
 
1125
               if Current_Verbosity = High then
1126
                  Write_Int  (Types.Int (Index));
1127
                  Write_Str  (": '");
1128
                  Write_Char (The_Name (Index));
1129
                  Write_Line ("' is not alphanumeric.");
1130
               end if;
1131
 
1132
               exit;
1133
            end if;
1134
         end if;
1135
      end loop;
1136
 
1137
      --  Cannot end with an underscore or a dot
1138
 
1139
      OK := OK and then not Need_Letter and then not Last_Underscore;
1140
 
1141
      if OK then
1142
         if First /= Name'First and then
1143
           Is_Reserved (The_Name (First .. The_Name'Last))
1144
         then
1145
            return;
1146
         end if;
1147
 
1148
         Unit := Real_Name;
1149
 
1150
      else
1151
         --  Signal a problem with No_Name
1152
 
1153
         Unit := No_Name;
1154
      end if;
1155
   end Check_Ada_Name;
1156
 
1157
   -------------------------
1158
   -- Check_Configuration --
1159
   -------------------------
1160
 
1161
   procedure Check_Configuration
1162
     (Project : Project_Id;
1163
      Data    : in out Tree_Processing_Data)
1164
   is
1165
      Dot_Replacement : File_Name_Type := No_File;
1166
      Casing          : Casing_Type    := All_Lower_Case;
1167
      Separate_Suffix : File_Name_Type := No_File;
1168
 
1169
      Lang_Index : Language_Ptr := No_Language_Index;
1170
      --  The index of the language data being checked
1171
 
1172
      Prev_Index : Language_Ptr := No_Language_Index;
1173
      --  The index of the previous language
1174
 
1175
      procedure Process_Project_Level_Simple_Attributes;
1176
      --  Process the simple attributes at the project level
1177
 
1178
      procedure Process_Project_Level_Array_Attributes;
1179
      --  Process the associate array attributes at the project level
1180
 
1181
      procedure Process_Packages;
1182
      --  Read the packages of the project
1183
 
1184
      ----------------------
1185
      -- Process_Packages --
1186
      ----------------------
1187
 
1188
      procedure Process_Packages is
1189
         Packages : Package_Id;
1190
         Element  : Package_Element;
1191
 
1192
         procedure Process_Binder (Arrays : Array_Id);
1193
         --  Process the associate array attributes of package Binder
1194
 
1195
         procedure Process_Builder (Attributes : Variable_Id);
1196
         --  Process the simple attributes of package Builder
1197
 
1198
         procedure Process_Compiler (Arrays : Array_Id);
1199
         --  Process the associate array attributes of package Compiler
1200
 
1201
         procedure Process_Naming (Attributes : Variable_Id);
1202
         --  Process the simple attributes of package Naming
1203
 
1204
         procedure Process_Naming (Arrays : Array_Id);
1205
         --  Process the associate array attributes of package Naming
1206
 
1207
         procedure Process_Linker (Attributes : Variable_Id);
1208
         --  Process the simple attributes of package Linker of a
1209
         --  configuration project.
1210
 
1211
         --------------------
1212
         -- Process_Binder --
1213
         --------------------
1214
 
1215
         procedure Process_Binder (Arrays : Array_Id) is
1216
            Current_Array_Id : Array_Id;
1217
            Current_Array    : Array_Data;
1218
            Element_Id       : Array_Element_Id;
1219
            Element          : Array_Element;
1220
 
1221
         begin
1222
            --  Process the associative array attribute of package Binder
1223
 
1224
            Current_Array_Id := Arrays;
1225
            while Current_Array_Id /= No_Array loop
1226
               Current_Array := Data.Tree.Arrays.Table (Current_Array_Id);
1227
 
1228
               Element_Id := Current_Array.Value;
1229
               while Element_Id /= No_Array_Element loop
1230
                  Element := Data.Tree.Array_Elements.Table (Element_Id);
1231
 
1232
                  if Element.Index /= All_Other_Names then
1233
 
1234
                     --  Get the name of the language
1235
 
1236
                     Lang_Index :=
1237
                       Get_Language_From_Name
1238
                         (Project, Get_Name_String (Element.Index));
1239
 
1240
                     if Lang_Index /= No_Language_Index then
1241
                        case Current_Array.Name is
1242
                           when Name_Driver =>
1243
 
1244
                              --  Attribute Driver (<language>)
1245
 
1246
                              Lang_Index.Config.Binder_Driver :=
1247
                                File_Name_Type (Element.Value.Value);
1248
 
1249
                           when Name_Required_Switches =>
1250
                              Put
1251
                                (Into_List =>
1252
                                   Lang_Index.Config.Binder_Required_Switches,
1253
                                 From_List => Element.Value.Values,
1254
                                 In_Tree   => Data.Tree);
1255
 
1256
                           when Name_Prefix =>
1257
 
1258
                              --  Attribute Prefix (<language>)
1259
 
1260
                              Lang_Index.Config.Binder_Prefix :=
1261
                                Element.Value.Value;
1262
 
1263
                           when Name_Objects_Path =>
1264
 
1265
                              --  Attribute Objects_Path (<language>)
1266
 
1267
                              Lang_Index.Config.Objects_Path :=
1268
                                Element.Value.Value;
1269
 
1270
                           when Name_Objects_Path_File =>
1271
 
1272
                              --  Attribute Objects_Path (<language>)
1273
 
1274
                              Lang_Index.Config.Objects_Path_File :=
1275
                                Element.Value.Value;
1276
 
1277
                           when others =>
1278
                              null;
1279
                        end case;
1280
                     end if;
1281
                  end if;
1282
 
1283
                  Element_Id := Element.Next;
1284
               end loop;
1285
 
1286
               Current_Array_Id := Current_Array.Next;
1287
            end loop;
1288
         end Process_Binder;
1289
 
1290
         ---------------------
1291
         -- Process_Builder --
1292
         ---------------------
1293
 
1294
         procedure Process_Builder (Attributes : Variable_Id) is
1295
            Attribute_Id : Variable_Id;
1296
            Attribute    : Variable;
1297
 
1298
         begin
1299
            --  Process non associated array attribute from package Builder
1300
 
1301
            Attribute_Id := Attributes;
1302
            while Attribute_Id /= No_Variable loop
1303
               Attribute :=
1304
                 Data.Tree.Variable_Elements.Table (Attribute_Id);
1305
 
1306
               if not Attribute.Value.Default then
1307
                  if Attribute.Name = Name_Executable_Suffix then
1308
 
1309
                     --  Attribute Executable_Suffix: the suffix of the
1310
                     --  executables.
1311
 
1312
                     Project.Config.Executable_Suffix :=
1313
                       Attribute.Value.Value;
1314
                  end if;
1315
               end if;
1316
 
1317
               Attribute_Id := Attribute.Next;
1318
            end loop;
1319
         end Process_Builder;
1320
 
1321
         ----------------------
1322
         -- Process_Compiler --
1323
         ----------------------
1324
 
1325
         procedure Process_Compiler (Arrays : Array_Id) is
1326
            Current_Array_Id : Array_Id;
1327
            Current_Array    : Array_Data;
1328
            Element_Id       : Array_Element_Id;
1329
            Element          : Array_Element;
1330
            List             : String_List_Id;
1331
 
1332
         begin
1333
            --  Process the associative array attribute of package Compiler
1334
 
1335
            Current_Array_Id := Arrays;
1336
            while Current_Array_Id /= No_Array loop
1337
               Current_Array := Data.Tree.Arrays.Table (Current_Array_Id);
1338
 
1339
               Element_Id := Current_Array.Value;
1340
               while Element_Id /= No_Array_Element loop
1341
                  Element := Data.Tree.Array_Elements.Table (Element_Id);
1342
 
1343
                  if Element.Index /= All_Other_Names then
1344
 
1345
                     --  Get the name of the language
1346
 
1347
                     Lang_Index := Get_Language_From_Name
1348
                       (Project, Get_Name_String (Element.Index));
1349
 
1350
                     if Lang_Index /= No_Language_Index then
1351
                        case Current_Array.Name is
1352
                        when Name_Dependency_Switches =>
1353
 
1354
                           --  Attribute Dependency_Switches (<language>)
1355
 
1356
                           if Lang_Index.Config.Dependency_Kind = None then
1357
                              Lang_Index.Config.Dependency_Kind := Makefile;
1358
                           end if;
1359
 
1360
                           List := Element.Value.Values;
1361
 
1362
                           if List /= Nil_String then
1363
                              Put (Into_List =>
1364
                                     Lang_Index.Config.Dependency_Option,
1365
                                   From_List => List,
1366
                                   In_Tree   => Data.Tree);
1367
                           end if;
1368
 
1369
                        when Name_Dependency_Driver =>
1370
 
1371
                           --  Attribute Dependency_Driver (<language>)
1372
 
1373
                           if Lang_Index.Config.Dependency_Kind = None then
1374
                              Lang_Index.Config.Dependency_Kind := Makefile;
1375
                           end if;
1376
 
1377
                           List := Element.Value.Values;
1378
 
1379
                           if List /= Nil_String then
1380
                              Put (Into_List =>
1381
                                     Lang_Index.Config.Compute_Dependency,
1382
                                   From_List => List,
1383
                                   In_Tree   => Data.Tree);
1384
                           end if;
1385
 
1386
                        when Name_Include_Switches =>
1387
 
1388
                           --  Attribute Include_Switches (<language>)
1389
 
1390
                           List := Element.Value.Values;
1391
 
1392
                           if List = Nil_String then
1393
                              Error_Msg
1394
                                (Data.Flags, "include option cannot be null",
1395
                                 Element.Value.Location, Project);
1396
                           end if;
1397
 
1398
                           Put (Into_List => Lang_Index.Config.Include_Option,
1399
                                From_List => List,
1400
                                In_Tree   => Data.Tree);
1401
 
1402
                        when Name_Include_Path =>
1403
 
1404
                           --  Attribute Include_Path (<language>)
1405
 
1406
                           Lang_Index.Config.Include_Path :=
1407
                             Element.Value.Value;
1408
 
1409
                        when Name_Include_Path_File =>
1410
 
1411
                           --  Attribute Include_Path_File (<language>)
1412
 
1413
                           Lang_Index.Config.Include_Path_File :=
1414
                               Element.Value.Value;
1415
 
1416
                        when Name_Driver =>
1417
 
1418
                           --  Attribute Driver (<language>)
1419
 
1420
                           Lang_Index.Config.Compiler_Driver :=
1421
                             File_Name_Type (Element.Value.Value);
1422
 
1423
                        when Name_Required_Switches |
1424
                             Name_Leading_Required_Switches =>
1425
                           Put (Into_List =>
1426
                                  Lang_Index.Config.
1427
                                    Compiler_Leading_Required_Switches,
1428
                                From_List => Element.Value.Values,
1429
                                In_Tree   => Data.Tree);
1430
 
1431
                        when Name_Trailing_Required_Switches =>
1432
                           Put (Into_List =>
1433
                                  Lang_Index.Config.
1434
                                    Compiler_Trailing_Required_Switches,
1435
                                From_List => Element.Value.Values,
1436
                                In_Tree   => Data.Tree);
1437
 
1438
                        when Name_Multi_Unit_Switches =>
1439
                           Put (Into_List =>
1440
                                  Lang_Index.Config.Multi_Unit_Switches,
1441
                                From_List => Element.Value.Values,
1442
                                In_Tree   => Data.Tree);
1443
 
1444
                        when Name_Multi_Unit_Object_Separator =>
1445
                           Get_Name_String (Element.Value.Value);
1446
 
1447
                           if Name_Len /= 1 then
1448
                              Error_Msg
1449
                                (Data.Flags,
1450
                                 "multi-unit object separator must have " &
1451
                                 "a single character",
1452
                                 Element.Value.Location, Project);
1453
 
1454
                           elsif Name_Buffer (1) = ' ' then
1455
                              Error_Msg
1456
                                (Data.Flags,
1457
                                 "multi-unit object separator cannot be " &
1458
                                 "a space",
1459
                                 Element.Value.Location, Project);
1460
 
1461
                           else
1462
                              Lang_Index.Config.Multi_Unit_Object_Separator :=
1463
                                Name_Buffer (1);
1464
                           end if;
1465
 
1466
                        when Name_Path_Syntax =>
1467
                           begin
1468
                              Lang_Index.Config.Path_Syntax :=
1469
                                  Path_Syntax_Kind'Value
1470
                                    (Get_Name_String (Element.Value.Value));
1471
 
1472
                           exception
1473
                              when Constraint_Error =>
1474
                                 Error_Msg
1475
                                   (Data.Flags,
1476
                                    "invalid value for Path_Syntax",
1477
                                    Element.Value.Location, Project);
1478
                           end;
1479
 
1480
                        when Name_Object_File_Suffix =>
1481
                           if Get_Name_String (Element.Value.Value) = "" then
1482
                              Error_Msg
1483
                                (Data.Flags,
1484
                                 "object file suffix cannot be empty",
1485
                                 Element.Value.Location, Project);
1486
 
1487
                           else
1488
                              Lang_Index.Config.Object_File_Suffix :=
1489
                                Element.Value.Value;
1490
                           end if;
1491
 
1492
                        when Name_Object_File_Switches =>
1493
                           Put (Into_List =>
1494
                                  Lang_Index.Config.Object_File_Switches,
1495
                                From_List => Element.Value.Values,
1496
                                In_Tree   => Data.Tree);
1497
 
1498
                        when Name_Pic_Option =>
1499
 
1500
                           --  Attribute Compiler_Pic_Option (<language>)
1501
 
1502
                           List := Element.Value.Values;
1503
 
1504
                           if List = Nil_String then
1505
                              Error_Msg
1506
                                (Data.Flags,
1507
                                 "compiler PIC option cannot be null",
1508
                                 Element.Value.Location, Project);
1509
                           end if;
1510
 
1511
                           Put (Into_List =>
1512
                                  Lang_Index.Config.Compilation_PIC_Option,
1513
                                From_List => List,
1514
                                In_Tree   => Data.Tree);
1515
 
1516
                        when Name_Mapping_File_Switches =>
1517
 
1518
                           --  Attribute Mapping_File_Switches (<language>)
1519
 
1520
                           List := Element.Value.Values;
1521
 
1522
                           if List = Nil_String then
1523
                              Error_Msg
1524
                                (Data.Flags,
1525
                                 "mapping file switches cannot be null",
1526
                                 Element.Value.Location, Project);
1527
                           end if;
1528
 
1529
                           Put (Into_List =>
1530
                                Lang_Index.Config.Mapping_File_Switches,
1531
                                From_List => List,
1532
                                In_Tree   => Data.Tree);
1533
 
1534
                        when Name_Mapping_Spec_Suffix =>
1535
 
1536
                           --  Attribute Mapping_Spec_Suffix (<language>)
1537
 
1538
                           Lang_Index.Config.Mapping_Spec_Suffix :=
1539
                             File_Name_Type (Element.Value.Value);
1540
 
1541
                        when Name_Mapping_Body_Suffix =>
1542
 
1543
                           --  Attribute Mapping_Body_Suffix (<language>)
1544
 
1545
                           Lang_Index.Config.Mapping_Body_Suffix :=
1546
                             File_Name_Type (Element.Value.Value);
1547
 
1548
                        when Name_Config_File_Switches =>
1549
 
1550
                           --  Attribute Config_File_Switches (<language>)
1551
 
1552
                           List := Element.Value.Values;
1553
 
1554
                           if List = Nil_String then
1555
                              Error_Msg
1556
                                (Data.Flags,
1557
                                 "config file switches cannot be null",
1558
                                 Element.Value.Location, Project);
1559
                           end if;
1560
 
1561
                           Put (Into_List =>
1562
                                  Lang_Index.Config.Config_File_Switches,
1563
                                From_List => List,
1564
                                In_Tree   => Data.Tree);
1565
 
1566
                        when Name_Objects_Path =>
1567
 
1568
                           --  Attribute Objects_Path (<language>)
1569
 
1570
                           Lang_Index.Config.Objects_Path :=
1571
                             Element.Value.Value;
1572
 
1573
                        when Name_Objects_Path_File =>
1574
 
1575
                           --  Attribute Objects_Path_File (<language>)
1576
 
1577
                           Lang_Index.Config.Objects_Path_File :=
1578
                             Element.Value.Value;
1579
 
1580
                        when Name_Config_Body_File_Name =>
1581
 
1582
                           --  Attribute Config_Body_File_Name (<language>)
1583
 
1584
                           Lang_Index.Config.Config_Body :=
1585
                             Element.Value.Value;
1586
 
1587
                        when Name_Config_Body_File_Name_Index =>
1588
 
1589
                           --  Attribute Config_Body_File_Name_Index
1590
                           --     ( < Language > )
1591
 
1592
                           Lang_Index.Config.Config_Body_Index :=
1593
                             Element.Value.Value;
1594
 
1595
                        when Name_Config_Body_File_Name_Pattern =>
1596
 
1597
                           --  Attribute Config_Body_File_Name_Pattern
1598
                           --    (<language>)
1599
 
1600
                           Lang_Index.Config.Config_Body_Pattern :=
1601
                             Element.Value.Value;
1602
 
1603
                        when Name_Config_Spec_File_Name =>
1604
 
1605
                           --  Attribute Config_Spec_File_Name (<language>)
1606
 
1607
                           Lang_Index.Config.Config_Spec :=
1608
                             Element.Value.Value;
1609
 
1610
                        when Name_Config_Spec_File_Name_Index =>
1611
 
1612
                           --  Attribute Config_Spec_File_Name_Index
1613
                           --    ( < Language > )
1614
 
1615
                           Lang_Index.Config.Config_Spec_Index :=
1616
                             Element.Value.Value;
1617
 
1618
                        when Name_Config_Spec_File_Name_Pattern =>
1619
 
1620
                           --  Attribute Config_Spec_File_Name_Pattern
1621
                           --    (<language>)
1622
 
1623
                           Lang_Index.Config.Config_Spec_Pattern :=
1624
                             Element.Value.Value;
1625
 
1626
                        when Name_Config_File_Unique =>
1627
 
1628
                           --  Attribute Config_File_Unique (<language>)
1629
 
1630
                           begin
1631
                              Lang_Index.Config.Config_File_Unique :=
1632
                                Boolean'Value
1633
                                  (Get_Name_String (Element.Value.Value));
1634
                           exception
1635
                              when Constraint_Error =>
1636
                                 Error_Msg
1637
                                   (Data.Flags,
1638
                                    "illegal value for Config_File_Unique",
1639
                                    Element.Value.Location, Project);
1640
                           end;
1641
 
1642
                        when others =>
1643
                           null;
1644
                        end case;
1645
                     end if;
1646
                  end if;
1647
 
1648
                  Element_Id := Element.Next;
1649
               end loop;
1650
 
1651
               Current_Array_Id := Current_Array.Next;
1652
            end loop;
1653
         end Process_Compiler;
1654
 
1655
         --------------------
1656
         -- Process_Naming --
1657
         --------------------
1658
 
1659
         procedure Process_Naming (Attributes : Variable_Id) is
1660
            Attribute_Id : Variable_Id;
1661
            Attribute    : Variable;
1662
 
1663
         begin
1664
            --  Process non associated array attribute from package Naming
1665
 
1666
            Attribute_Id := Attributes;
1667
            while Attribute_Id /= No_Variable loop
1668
               Attribute := Data.Tree.Variable_Elements.Table (Attribute_Id);
1669
 
1670
               if not Attribute.Value.Default then
1671
                  if Attribute.Name = Name_Separate_Suffix then
1672
 
1673
                     --  Attribute Separate_Suffix
1674
 
1675
                     Get_Name_String (Attribute.Value.Value);
1676
                     Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
1677
                     Separate_Suffix := Name_Find;
1678
 
1679
                  elsif Attribute.Name = Name_Casing then
1680
 
1681
                     --  Attribute Casing
1682
 
1683
                     begin
1684
                        Casing :=
1685
                          Value (Get_Name_String (Attribute.Value.Value));
1686
 
1687
                     exception
1688
                        when Constraint_Error =>
1689
                           Error_Msg
1690
                             (Data.Flags,
1691
                              "invalid value for Casing",
1692
                              Attribute.Value.Location, Project);
1693
                     end;
1694
 
1695
                  elsif Attribute.Name = Name_Dot_Replacement then
1696
 
1697
                     --  Attribute Dot_Replacement
1698
 
1699
                     Dot_Replacement := File_Name_Type (Attribute.Value.Value);
1700
 
1701
                  end if;
1702
               end if;
1703
 
1704
               Attribute_Id := Attribute.Next;
1705
            end loop;
1706
         end Process_Naming;
1707
 
1708
         procedure Process_Naming (Arrays : Array_Id) is
1709
            Current_Array_Id : Array_Id;
1710
            Current_Array    : Array_Data;
1711
            Element_Id       : Array_Element_Id;
1712
            Element          : Array_Element;
1713
 
1714
         begin
1715
            --  Process the associative array attribute of package Naming
1716
 
1717
            Current_Array_Id := Arrays;
1718
            while Current_Array_Id /= No_Array loop
1719
               Current_Array := Data.Tree.Arrays.Table (Current_Array_Id);
1720
 
1721
               Element_Id := Current_Array.Value;
1722
               while Element_Id /= No_Array_Element loop
1723
                  Element := Data.Tree.Array_Elements.Table (Element_Id);
1724
 
1725
                  --  Get the name of the language
1726
 
1727
                  Lang_Index := Get_Language_From_Name
1728
                    (Project, Get_Name_String (Element.Index));
1729
 
1730
                  if Lang_Index /= No_Language_Index then
1731
                     case Current_Array.Name is
1732
                        when Name_Spec_Suffix | Name_Specification_Suffix =>
1733
 
1734
                           --  Attribute Spec_Suffix (<language>)
1735
 
1736
                           Get_Name_String (Element.Value.Value);
1737
                           Canonical_Case_File_Name
1738
                             (Name_Buffer (1 .. Name_Len));
1739
                           Lang_Index.Config.Naming_Data.Spec_Suffix :=
1740
                             Name_Find;
1741
 
1742
                        when Name_Implementation_Suffix | Name_Body_Suffix =>
1743
 
1744
                           Get_Name_String (Element.Value.Value);
1745
                           Canonical_Case_File_Name
1746
                             (Name_Buffer (1 .. Name_Len));
1747
 
1748
                           --  Attribute Body_Suffix (<language>)
1749
 
1750
                           Lang_Index.Config.Naming_Data.Body_Suffix :=
1751
                             Name_Find;
1752
                           Lang_Index.Config.Naming_Data.Separate_Suffix :=
1753
                             Lang_Index.Config.Naming_Data.Body_Suffix;
1754
 
1755
                        when others =>
1756
                           null;
1757
                     end case;
1758
                  end if;
1759
 
1760
                  Element_Id := Element.Next;
1761
               end loop;
1762
 
1763
               Current_Array_Id := Current_Array.Next;
1764
            end loop;
1765
         end Process_Naming;
1766
 
1767
         --------------------
1768
         -- Process_Linker --
1769
         --------------------
1770
 
1771
         procedure Process_Linker (Attributes : Variable_Id) is
1772
            Attribute_Id : Variable_Id;
1773
            Attribute    : Variable;
1774
 
1775
         begin
1776
            --  Process non associated array attribute from package Linker
1777
 
1778
            Attribute_Id := Attributes;
1779
            while Attribute_Id /= No_Variable loop
1780
               Attribute :=
1781
                 Data.Tree.Variable_Elements.Table (Attribute_Id);
1782
 
1783
               if not Attribute.Value.Default then
1784
                  if Attribute.Name = Name_Driver then
1785
 
1786
                     --  Attribute Linker'Driver: the default linker to use
1787
 
1788
                     Project.Config.Linker :=
1789
                       Path_Name_Type (Attribute.Value.Value);
1790
 
1791
                     --  Linker'Driver is also used to link shared libraries
1792
                     --  if the obsolescent attribute Library_GCC has not been
1793
                     --  specified.
1794
 
1795
                     if Project.Config.Shared_Lib_Driver = No_File then
1796
                        Project.Config.Shared_Lib_Driver :=
1797
                          File_Name_Type (Attribute.Value.Value);
1798
                     end if;
1799
 
1800
                  elsif Attribute.Name = Name_Required_Switches then
1801
 
1802
                     --  Attribute Required_Switches: the minimum
1803
                     --  options to use when invoking the linker
1804
 
1805
                     Put (Into_List => Project.Config.Minimum_Linker_Options,
1806
                          From_List => Attribute.Value.Values,
1807
                          In_Tree   => Data.Tree);
1808
 
1809
                  elsif Attribute.Name = Name_Map_File_Option then
1810
                     Project.Config.Map_File_Option := Attribute.Value.Value;
1811
 
1812
                  elsif Attribute.Name = Name_Max_Command_Line_Length then
1813
                     begin
1814
                        Project.Config.Max_Command_Line_Length :=
1815
                          Natural'Value (Get_Name_String
1816
                                         (Attribute.Value.Value));
1817
 
1818
                     exception
1819
                        when Constraint_Error =>
1820
                           Error_Msg
1821
                             (Data.Flags,
1822
                              "value must be positive or equal to 0",
1823
                              Attribute.Value.Location, Project);
1824
                     end;
1825
 
1826
                  elsif Attribute.Name = Name_Response_File_Format then
1827
                     declare
1828
                        Name  : Name_Id;
1829
 
1830
                     begin
1831
                        Get_Name_String (Attribute.Value.Value);
1832
                        To_Lower (Name_Buffer (1 .. Name_Len));
1833
                        Name := Name_Find;
1834
 
1835
                        if Name = Name_None then
1836
                           Project.Config.Resp_File_Format := None;
1837
 
1838
                        elsif Name = Name_Gnu then
1839
                           Project.Config.Resp_File_Format := GNU;
1840
 
1841
                        elsif Name = Name_Object_List then
1842
                           Project.Config.Resp_File_Format := Object_List;
1843
 
1844
                        elsif Name = Name_Option_List then
1845
                           Project.Config.Resp_File_Format := Option_List;
1846
 
1847
                        else
1848
                           Error_Msg
1849
                             (Data.Flags,
1850
                              "illegal response file format",
1851
                              Attribute.Value.Location, Project);
1852
                        end if;
1853
                     end;
1854
 
1855
                  elsif Attribute.Name = Name_Response_File_Switches then
1856
                     Put (Into_List => Project.Config.Resp_File_Options,
1857
                          From_List => Attribute.Value.Values,
1858
                          In_Tree   => Data.Tree);
1859
                  end if;
1860
               end if;
1861
 
1862
               Attribute_Id := Attribute.Next;
1863
            end loop;
1864
         end Process_Linker;
1865
 
1866
      --  Start of processing for Process_Packages
1867
 
1868
      begin
1869
         Packages := Project.Decl.Packages;
1870
         while Packages /= No_Package loop
1871
            Element := Data.Tree.Packages.Table (Packages);
1872
 
1873
            case Element.Name is
1874
               when Name_Binder =>
1875
 
1876
                  --  Process attributes of package Binder
1877
 
1878
                  Process_Binder (Element.Decl.Arrays);
1879
 
1880
               when Name_Builder =>
1881
 
1882
                  --  Process attributes of package Builder
1883
 
1884
                  Process_Builder (Element.Decl.Attributes);
1885
 
1886
               when Name_Compiler =>
1887
 
1888
                  --  Process attributes of package Compiler
1889
 
1890
                  Process_Compiler (Element.Decl.Arrays);
1891
 
1892
               when Name_Linker =>
1893
 
1894
                  --  Process attributes of package Linker
1895
 
1896
                  Process_Linker (Element.Decl.Attributes);
1897
 
1898
               when Name_Naming =>
1899
 
1900
                  --  Process attributes of package Naming
1901
 
1902
                  Process_Naming (Element.Decl.Attributes);
1903
                  Process_Naming (Element.Decl.Arrays);
1904
 
1905
               when others =>
1906
                  null;
1907
            end case;
1908
 
1909
            Packages := Element.Next;
1910
         end loop;
1911
      end Process_Packages;
1912
 
1913
      ---------------------------------------------
1914
      -- Process_Project_Level_Simple_Attributes --
1915
      ---------------------------------------------
1916
 
1917
      procedure Process_Project_Level_Simple_Attributes is
1918
         Attribute_Id : Variable_Id;
1919
         Attribute    : Variable;
1920
         List         : String_List_Id;
1921
 
1922
      begin
1923
         --  Process non associated array attribute at project level
1924
 
1925
         Attribute_Id := Project.Decl.Attributes;
1926
         while Attribute_Id /= No_Variable loop
1927
            Attribute :=
1928
              Data.Tree.Variable_Elements.Table (Attribute_Id);
1929
 
1930
            if not Attribute.Value.Default then
1931
               if Attribute.Name = Name_Target then
1932
 
1933
                  --  Attribute Target: the target specified
1934
 
1935
                  Project.Config.Target := Attribute.Value.Value;
1936
 
1937
               elsif Attribute.Name = Name_Library_Builder then
1938
 
1939
                  --  Attribute Library_Builder: the application to invoke
1940
                  --  to build libraries.
1941
 
1942
                  Project.Config.Library_Builder :=
1943
                    Path_Name_Type (Attribute.Value.Value);
1944
 
1945
               elsif Attribute.Name = Name_Archive_Builder then
1946
 
1947
                  --  Attribute Archive_Builder: the archive builder
1948
                  --  (usually "ar") and its minimum options (usually "cr").
1949
 
1950
                  List := Attribute.Value.Values;
1951
 
1952
                  if List = Nil_String then
1953
                     Error_Msg
1954
                       (Data.Flags,
1955
                        "archive builder cannot be null",
1956
                        Attribute.Value.Location, Project);
1957
                  end if;
1958
 
1959
                  Put (Into_List => Project.Config.Archive_Builder,
1960
                       From_List => List,
1961
                       In_Tree   => Data.Tree);
1962
 
1963
               elsif Attribute.Name = Name_Archive_Builder_Append_Option then
1964
 
1965
                  --  Attribute Archive_Builder: the archive builder
1966
                  --  (usually "ar") and its minimum options (usually "cr").
1967
 
1968
                  List := Attribute.Value.Values;
1969
 
1970
                  if List /= Nil_String then
1971
                     Put
1972
                       (Into_List =>
1973
                          Project.Config.Archive_Builder_Append_Option,
1974
                        From_List => List,
1975
                        In_Tree   => Data.Tree);
1976
                  end if;
1977
 
1978
               elsif Attribute.Name = Name_Archive_Indexer then
1979
 
1980
                  --  Attribute Archive_Indexer: the optional archive
1981
                  --  indexer (usually "ranlib") with its minimum options
1982
                  --  (usually none).
1983
 
1984
                  List := Attribute.Value.Values;
1985
 
1986
                  if List = Nil_String then
1987
                     Error_Msg
1988
                       (Data.Flags,
1989
                        "archive indexer cannot be null",
1990
                        Attribute.Value.Location, Project);
1991
                  end if;
1992
 
1993
                  Put (Into_List => Project.Config.Archive_Indexer,
1994
                       From_List => List,
1995
                       In_Tree   => Data.Tree);
1996
 
1997
               elsif Attribute.Name = Name_Library_Partial_Linker then
1998
 
1999
                  --  Attribute Library_Partial_Linker: the optional linker
2000
                  --  driver with its minimum options, to partially link
2001
                  --  archives.
2002
 
2003
                  List := Attribute.Value.Values;
2004
 
2005
                  if List = Nil_String then
2006
                     Error_Msg
2007
                       (Data.Flags,
2008
                        "partial linker cannot be null",
2009
                        Attribute.Value.Location, Project);
2010
                  end if;
2011
 
2012
                  Put (Into_List => Project.Config.Lib_Partial_Linker,
2013
                       From_List => List,
2014
                       In_Tree   => Data.Tree);
2015
 
2016
               elsif Attribute.Name = Name_Library_GCC then
2017
                  Project.Config.Shared_Lib_Driver :=
2018
                    File_Name_Type (Attribute.Value.Value);
2019
                  Error_Msg
2020
                    (Data.Flags,
2021
                     "?Library_'G'C'C is an obsolescent attribute, " &
2022
                     "use Linker''Driver instead",
2023
                     Attribute.Value.Location, Project);
2024
 
2025
               elsif Attribute.Name = Name_Archive_Suffix then
2026
                  Project.Config.Archive_Suffix :=
2027
                    File_Name_Type (Attribute.Value.Value);
2028
 
2029
               elsif Attribute.Name = Name_Linker_Executable_Option then
2030
 
2031
                  --  Attribute Linker_Executable_Option: optional options
2032
                  --  to specify an executable name. Defaults to "-o".
2033
 
2034
                  List := Attribute.Value.Values;
2035
 
2036
                  if List = Nil_String then
2037
                     Error_Msg
2038
                       (Data.Flags,
2039
                        "linker executable option cannot be null",
2040
                        Attribute.Value.Location, Project);
2041
                  end if;
2042
 
2043
                  Put (Into_List => Project.Config.Linker_Executable_Option,
2044
                       From_List => List,
2045
                       In_Tree   => Data.Tree);
2046
 
2047
               elsif Attribute.Name = Name_Linker_Lib_Dir_Option then
2048
 
2049
                  --  Attribute Linker_Lib_Dir_Option: optional options
2050
                  --  to specify a library search directory. Defaults to
2051
                  --  "-L".
2052
 
2053
                  Get_Name_String (Attribute.Value.Value);
2054
 
2055
                  if Name_Len = 0 then
2056
                     Error_Msg
2057
                       (Data.Flags,
2058
                        "linker library directory option cannot be empty",
2059
                        Attribute.Value.Location, Project);
2060
                  end if;
2061
 
2062
                  Project.Config.Linker_Lib_Dir_Option :=
2063
                    Attribute.Value.Value;
2064
 
2065
               elsif Attribute.Name = Name_Linker_Lib_Name_Option then
2066
 
2067
                  --  Attribute Linker_Lib_Name_Option: optional options
2068
                  --  to specify the name of a library to be linked in.
2069
                  --  Defaults to "-l".
2070
 
2071
                  Get_Name_String (Attribute.Value.Value);
2072
 
2073
                  if Name_Len = 0 then
2074
                     Error_Msg
2075
                       (Data.Flags,
2076
                        "linker library name option cannot be empty",
2077
                        Attribute.Value.Location, Project);
2078
                  end if;
2079
 
2080
                  Project.Config.Linker_Lib_Name_Option :=
2081
                    Attribute.Value.Value;
2082
 
2083
               elsif Attribute.Name = Name_Run_Path_Option then
2084
 
2085
                  --  Attribute Run_Path_Option: optional options to
2086
                  --  specify a path for libraries.
2087
 
2088
                  List := Attribute.Value.Values;
2089
 
2090
                  if List /= Nil_String then
2091
                     Put (Into_List => Project.Config.Run_Path_Option,
2092
                          From_List => List,
2093
                          In_Tree   => Data.Tree);
2094
                  end if;
2095
 
2096
               elsif Attribute.Name = Name_Run_Path_Origin then
2097
                  Get_Name_String (Attribute.Value.Value);
2098
 
2099
                  if Name_Len = 0 then
2100
                     Error_Msg
2101
                       (Data.Flags,
2102
                        "run path origin cannot be empty",
2103
                        Attribute.Value.Location, Project);
2104
                  end if;
2105
 
2106
                  Project.Config.Run_Path_Origin := Attribute.Value.Value;
2107
 
2108
               elsif Attribute.Name = Name_Library_Install_Name_Option then
2109
                  Project.Config.Library_Install_Name_Option :=
2110
                    Attribute.Value.Value;
2111
 
2112
               elsif Attribute.Name = Name_Separate_Run_Path_Options then
2113
                  declare
2114
                     pragma Unsuppress (All_Checks);
2115
                  begin
2116
                     Project.Config.Separate_Run_Path_Options :=
2117
                       Boolean'Value (Get_Name_String (Attribute.Value.Value));
2118
                  exception
2119
                     when Constraint_Error =>
2120
                        Error_Msg
2121
                          (Data.Flags,
2122
                           "invalid value """ &
2123
                           Get_Name_String (Attribute.Value.Value) &
2124
                           """ for Separate_Run_Path_Options",
2125
                           Attribute.Value.Location, Project);
2126
                  end;
2127
 
2128
               elsif Attribute.Name = Name_Library_Support then
2129
                  declare
2130
                     pragma Unsuppress (All_Checks);
2131
                  begin
2132
                     Project.Config.Lib_Support :=
2133
                       Library_Support'Value (Get_Name_String
2134
                                              (Attribute.Value.Value));
2135
                  exception
2136
                     when Constraint_Error =>
2137
                        Error_Msg
2138
                          (Data.Flags,
2139
                           "invalid value """ &
2140
                           Get_Name_String (Attribute.Value.Value) &
2141
                           """ for Library_Support",
2142
                           Attribute.Value.Location, Project);
2143
                  end;
2144
 
2145
               elsif Attribute.Name = Name_Shared_Library_Prefix then
2146
                  Project.Config.Shared_Lib_Prefix :=
2147
                    File_Name_Type (Attribute.Value.Value);
2148
 
2149
               elsif Attribute.Name = Name_Shared_Library_Suffix then
2150
                  Project.Config.Shared_Lib_Suffix :=
2151
                    File_Name_Type (Attribute.Value.Value);
2152
 
2153
               elsif Attribute.Name = Name_Symbolic_Link_Supported then
2154
                  declare
2155
                     pragma Unsuppress (All_Checks);
2156
                  begin
2157
                     Project.Config.Symbolic_Link_Supported :=
2158
                       Boolean'Value (Get_Name_String
2159
                                      (Attribute.Value.Value));
2160
                  exception
2161
                     when Constraint_Error =>
2162
                        Error_Msg
2163
                          (Data.Flags,
2164
                           "invalid value """
2165
                             & Get_Name_String (Attribute.Value.Value)
2166
                             & """ for Symbolic_Link_Supported",
2167
                           Attribute.Value.Location, Project);
2168
                  end;
2169
 
2170
               elsif
2171
                 Attribute.Name = Name_Library_Major_Minor_Id_Supported
2172
               then
2173
                  declare
2174
                     pragma Unsuppress (All_Checks);
2175
                  begin
2176
                     Project.Config.Lib_Maj_Min_Id_Supported :=
2177
                       Boolean'Value (Get_Name_String
2178
                                      (Attribute.Value.Value));
2179
                  exception
2180
                     when Constraint_Error =>
2181
                        Error_Msg
2182
                          (Data.Flags,
2183
                           "invalid value """ &
2184
                           Get_Name_String (Attribute.Value.Value) &
2185
                           """ for Library_Major_Minor_Id_Supported",
2186
                           Attribute.Value.Location, Project);
2187
                  end;
2188
 
2189
               elsif Attribute.Name = Name_Library_Auto_Init_Supported then
2190
                  declare
2191
                     pragma Unsuppress (All_Checks);
2192
                  begin
2193
                     Project.Config.Auto_Init_Supported :=
2194
                       Boolean'Value (Get_Name_String (Attribute.Value.Value));
2195
                  exception
2196
                     when Constraint_Error =>
2197
                        Error_Msg
2198
                          (Data.Flags,
2199
                           "invalid value """
2200
                             & Get_Name_String (Attribute.Value.Value)
2201
                             & """ for Library_Auto_Init_Supported",
2202
                           Attribute.Value.Location, Project);
2203
                  end;
2204
 
2205
               elsif Attribute.Name = Name_Shared_Library_Minimum_Switches then
2206
                  List := Attribute.Value.Values;
2207
 
2208
                  if List /= Nil_String then
2209
                     Put (Into_List => Project.Config.Shared_Lib_Min_Options,
2210
                          From_List => List,
2211
                          In_Tree   => Data.Tree);
2212
                  end if;
2213
 
2214
               elsif Attribute.Name = Name_Library_Version_Switches then
2215
                  List := Attribute.Value.Values;
2216
 
2217
                  if List /= Nil_String then
2218
                     Put (Into_List => Project.Config.Lib_Version_Options,
2219
                          From_List => List,
2220
                          In_Tree   => Data.Tree);
2221
                  end if;
2222
               end if;
2223
            end if;
2224
 
2225
            Attribute_Id := Attribute.Next;
2226
         end loop;
2227
      end Process_Project_Level_Simple_Attributes;
2228
 
2229
      --------------------------------------------
2230
      -- Process_Project_Level_Array_Attributes --
2231
      --------------------------------------------
2232
 
2233
      procedure Process_Project_Level_Array_Attributes is
2234
         Current_Array_Id : Array_Id;
2235
         Current_Array    : Array_Data;
2236
         Element_Id       : Array_Element_Id;
2237
         Element          : Array_Element;
2238
         List             : String_List_Id;
2239
 
2240
      begin
2241
         --  Process the associative array attributes at project level
2242
 
2243
         Current_Array_Id := Project.Decl.Arrays;
2244
         while Current_Array_Id /= No_Array loop
2245
            Current_Array := Data.Tree.Arrays.Table (Current_Array_Id);
2246
 
2247
            Element_Id := Current_Array.Value;
2248
            while Element_Id /= No_Array_Element loop
2249
               Element := Data.Tree.Array_Elements.Table (Element_Id);
2250
 
2251
               --  Get the name of the language
2252
 
2253
               Lang_Index :=
2254
                 Get_Language_From_Name
2255
                   (Project, Get_Name_String (Element.Index));
2256
 
2257
               if Lang_Index /= No_Language_Index then
2258
                  case Current_Array.Name is
2259
                     when Name_Inherit_Source_Path =>
2260
                        List := Element.Value.Values;
2261
 
2262
                        if List /= Nil_String then
2263
                           Put
2264
                             (Into_List  =>
2265
                                Lang_Index.Config.Include_Compatible_Languages,
2266
                              From_List  => List,
2267
                              In_Tree    => Data.Tree,
2268
                              Lower_Case => True);
2269
                        end if;
2270
 
2271
                     when Name_Toolchain_Description =>
2272
 
2273
                        --  Attribute Toolchain_Description (<language>)
2274
 
2275
                        Lang_Index.Config.Toolchain_Description :=
2276
                          Element.Value.Value;
2277
 
2278
                     when Name_Toolchain_Version =>
2279
 
2280
                        --  Attribute Toolchain_Version (<language>)
2281
 
2282
                        Lang_Index.Config.Toolchain_Version :=
2283
                          Element.Value.Value;
2284
 
2285
                     when Name_Runtime_Library_Dir =>
2286
 
2287
                        --  Attribute Runtime_Library_Dir (<language>)
2288
 
2289
                        Lang_Index.Config.Runtime_Library_Dir :=
2290
                          Element.Value.Value;
2291
 
2292
                     when Name_Runtime_Source_Dir =>
2293
 
2294
                        --  Attribute Runtime_Library_Dir (<language>)
2295
 
2296
                        Lang_Index.Config.Runtime_Source_Dir :=
2297
                          Element.Value.Value;
2298
 
2299
                     when Name_Object_Generated =>
2300
                        declare
2301
                           pragma Unsuppress (All_Checks);
2302
                           Value : Boolean;
2303
 
2304
                        begin
2305
                           Value :=
2306
                             Boolean'Value
2307
                               (Get_Name_String (Element.Value.Value));
2308
 
2309
                           Lang_Index.Config.Object_Generated := Value;
2310
 
2311
                           --  If no object is generated, no object may be
2312
                           --  linked.
2313
 
2314
                           if not Value then
2315
                              Lang_Index.Config.Objects_Linked := False;
2316
                           end if;
2317
 
2318
                        exception
2319
                           when Constraint_Error =>
2320
                              Error_Msg
2321
                                (Data.Flags,
2322
                                 "invalid value """
2323
                                 & Get_Name_String (Element.Value.Value)
2324
                                 & """ for Object_Generated",
2325
                                 Element.Value.Location, Project);
2326
                        end;
2327
 
2328
                     when Name_Objects_Linked =>
2329
                        declare
2330
                           pragma Unsuppress (All_Checks);
2331
                           Value : Boolean;
2332
 
2333
                        begin
2334
                           Value :=
2335
                             Boolean'Value
2336
                               (Get_Name_String (Element.Value.Value));
2337
 
2338
                           --  No change if Object_Generated is False, as this
2339
                           --  forces Objects_Linked to be False too.
2340
 
2341
                           if Lang_Index.Config.Object_Generated then
2342
                              Lang_Index.Config.Objects_Linked := Value;
2343
                           end if;
2344
 
2345
                        exception
2346
                           when Constraint_Error =>
2347
                              Error_Msg
2348
                                (Data.Flags,
2349
                                 "invalid value """
2350
                                 & Get_Name_String (Element.Value.Value)
2351
                                 & """ for Objects_Linked",
2352
                                 Element.Value.Location, Project);
2353
                        end;
2354
                     when others =>
2355
                        null;
2356
                  end case;
2357
               end if;
2358
 
2359
               Element_Id := Element.Next;
2360
            end loop;
2361
 
2362
            Current_Array_Id := Current_Array.Next;
2363
         end loop;
2364
      end Process_Project_Level_Array_Attributes;
2365
 
2366
   --  Start of processing for Check_Configuration
2367
 
2368
   begin
2369
      Process_Project_Level_Simple_Attributes;
2370
      Process_Project_Level_Array_Attributes;
2371
      Process_Packages;
2372
 
2373
      --  For unit based languages, set Casing, Dot_Replacement and
2374
      --  Separate_Suffix in Naming_Data.
2375
 
2376
      Lang_Index := Project.Languages;
2377
      while Lang_Index /= No_Language_Index loop
2378
         if Lang_Index.Name = Name_Ada then
2379
            Lang_Index.Config.Naming_Data.Casing := Casing;
2380
            Lang_Index.Config.Naming_Data.Dot_Replacement := Dot_Replacement;
2381
 
2382
            if Separate_Suffix /= No_File then
2383
               Lang_Index.Config.Naming_Data.Separate_Suffix :=
2384
                 Separate_Suffix;
2385
            end if;
2386
 
2387
            exit;
2388
         end if;
2389
 
2390
         Lang_Index := Lang_Index.Next;
2391
      end loop;
2392
 
2393
      --  Give empty names to various prefixes/suffixes, if they have not
2394
      --  been specified in the configuration.
2395
 
2396
      if Project.Config.Archive_Suffix = No_File then
2397
         Project.Config.Archive_Suffix := Empty_File;
2398
      end if;
2399
 
2400
      if Project.Config.Shared_Lib_Prefix = No_File then
2401
         Project.Config.Shared_Lib_Prefix := Empty_File;
2402
      end if;
2403
 
2404
      if Project.Config.Shared_Lib_Suffix = No_File then
2405
         Project.Config.Shared_Lib_Suffix := Empty_File;
2406
      end if;
2407
 
2408
      Lang_Index := Project.Languages;
2409
      while Lang_Index /= No_Language_Index loop
2410
 
2411
         --  For all languages, Compiler_Driver needs to be specified. This is
2412
         --  only needed if we do intend to compile (not in GPS for instance).
2413
 
2414
         if Data.Flags.Compiler_Driver_Mandatory
2415
           and then Lang_Index.Config.Compiler_Driver = No_File
2416
         then
2417
            Error_Msg_Name_1 := Lang_Index.Display_Name;
2418
            Error_Msg
2419
              (Data.Flags,
2420
               "?no compiler specified for language %%" &
2421
                 ", ignoring all its sources",
2422
               No_Location, Project);
2423
 
2424
            if Lang_Index = Project.Languages then
2425
               Project.Languages := Lang_Index.Next;
2426
            else
2427
               Prev_Index.Next := Lang_Index.Next;
2428
            end if;
2429
 
2430
         elsif Lang_Index.Name = Name_Ada then
2431
            Prev_Index := Lang_Index;
2432
 
2433
            --  For unit based languages, Dot_Replacement, Spec_Suffix and
2434
            --  Body_Suffix need to be specified.
2435
 
2436
            if Lang_Index.Config.Naming_Data.Dot_Replacement = No_File then
2437
               Error_Msg
2438
                 (Data.Flags,
2439
                  "Dot_Replacement not specified for Ada",
2440
                  No_Location, Project);
2441
            end if;
2442
 
2443
            if Lang_Index.Config.Naming_Data.Spec_Suffix = No_File then
2444
               Error_Msg
2445
                 (Data.Flags,
2446
                  "Spec_Suffix not specified for Ada",
2447
                  No_Location, Project);
2448
            end if;
2449
 
2450
            if Lang_Index.Config.Naming_Data.Body_Suffix = No_File then
2451
               Error_Msg
2452
                 (Data.Flags,
2453
                  "Body_Suffix not specified for Ada",
2454
                  No_Location, Project);
2455
            end if;
2456
 
2457
         else
2458
            Prev_Index := Lang_Index;
2459
 
2460
            --  For file based languages, either Spec_Suffix or Body_Suffix
2461
            --  need to be specified.
2462
 
2463
            if Data.Flags.Require_Sources_Other_Lang
2464
              and then Lang_Index.Config.Naming_Data.Spec_Suffix = No_File
2465
              and then Lang_Index.Config.Naming_Data.Body_Suffix = No_File
2466
            then
2467
               Error_Msg_Name_1 := Lang_Index.Display_Name;
2468
               Error_Msg
2469
                 (Data.Flags,
2470
                  "no suffixes specified for %%",
2471
                  No_Location, Project);
2472
            end if;
2473
         end if;
2474
 
2475
         Lang_Index := Lang_Index.Next;
2476
      end loop;
2477
   end Check_Configuration;
2478
 
2479
   -------------------------------
2480
   -- Check_If_Externally_Built --
2481
   -------------------------------
2482
 
2483
   procedure Check_If_Externally_Built
2484
     (Project : Project_Id;
2485
      Data    : in out Tree_Processing_Data)
2486
   is
2487
      Externally_Built : constant Variable_Value :=
2488
                           Util.Value_Of
2489
                            (Name_Externally_Built,
2490
                             Project.Decl.Attributes, Data.Tree);
2491
 
2492
   begin
2493
      if not Externally_Built.Default then
2494
         Get_Name_String (Externally_Built.Value);
2495
         To_Lower (Name_Buffer (1 .. Name_Len));
2496
 
2497
         if Name_Buffer (1 .. Name_Len) = "true" then
2498
            Project.Externally_Built := True;
2499
 
2500
         elsif Name_Buffer (1 .. Name_Len) /= "false" then
2501
            Error_Msg (Data.Flags,
2502
                       "Externally_Built may only be true or false",
2503
                       Externally_Built.Location, Project);
2504
         end if;
2505
      end if;
2506
 
2507
      --  A virtual project extending an externally built project is itself
2508
      --  externally built.
2509
 
2510
      if Project.Virtual and then Project.Extends /= No_Project then
2511
         Project.Externally_Built := Project.Extends.Externally_Built;
2512
      end if;
2513
 
2514
      if Current_Verbosity = High then
2515
         Write_Str ("Project is ");
2516
 
2517
         if not Project.Externally_Built then
2518
            Write_Str ("not ");
2519
         end if;
2520
 
2521
         Write_Line ("externally built.");
2522
      end if;
2523
   end Check_If_Externally_Built;
2524
 
2525
   ----------------------
2526
   -- Check_Interfaces --
2527
   ----------------------
2528
 
2529
   procedure Check_Interfaces
2530
     (Project : Project_Id;
2531
      Data    : in out Tree_Processing_Data)
2532
   is
2533
      Interfaces : constant Prj.Variable_Value :=
2534
                     Prj.Util.Value_Of
2535
                       (Snames.Name_Interfaces,
2536
                        Project.Decl.Attributes,
2537
                        Data.Tree);
2538
 
2539
      Library_Interface : constant Prj.Variable_Value :=
2540
                            Prj.Util.Value_Of
2541
                              (Snames.Name_Library_Interface,
2542
                               Project.Decl.Attributes,
2543
                               Data.Tree);
2544
 
2545
      List      : String_List_Id;
2546
      Element   : String_Element;
2547
      Name      : File_Name_Type;
2548
      Iter      : Source_Iterator;
2549
      Source    : Source_Id;
2550
      Project_2 : Project_Id;
2551
      Other     : Source_Id;
2552
 
2553
   begin
2554
      if not Interfaces.Default then
2555
 
2556
         --  Set In_Interfaces to False for all sources. It will be set to True
2557
         --  later for the sources in the Interfaces list.
2558
 
2559
         Project_2 := Project;
2560
         while Project_2 /= No_Project loop
2561
            Iter := For_Each_Source (Data.Tree, Project_2);
2562
            loop
2563
               Source := Prj.Element (Iter);
2564
               exit when Source = No_Source;
2565
               Source.In_Interfaces := False;
2566
               Next (Iter);
2567
            end loop;
2568
 
2569
            Project_2 := Project_2.Extends;
2570
         end loop;
2571
 
2572
         List := Interfaces.Values;
2573
         while List /= Nil_String loop
2574
            Element := Data.Tree.String_Elements.Table (List);
2575
            Name := Canonical_Case_File_Name (Element.Value);
2576
 
2577
            Project_2 := Project;
2578
            Big_Loop :
2579
            while Project_2 /= No_Project loop
2580
               Iter := For_Each_Source (Data.Tree, Project_2);
2581
 
2582
               loop
2583
                  Source := Prj.Element (Iter);
2584
                  exit when Source = No_Source;
2585
 
2586
                  if Source.File = Name then
2587
                     if not Source.Locally_Removed then
2588
                        Source.In_Interfaces := True;
2589
                        Source.Declared_In_Interfaces := True;
2590
 
2591
                        Other := Other_Part (Source);
2592
 
2593
                        if Other /= No_Source then
2594
                           Other.In_Interfaces := True;
2595
                           Other.Declared_In_Interfaces := True;
2596
                        end if;
2597
 
2598
                        if Current_Verbosity = High then
2599
                           Write_Str ("   interface: ");
2600
                           Write_Line (Get_Name_String (Source.Path.Name));
2601
                        end if;
2602
                     end if;
2603
 
2604
                     exit Big_Loop;
2605
                  end if;
2606
 
2607
                  Next (Iter);
2608
               end loop;
2609
 
2610
               Project_2 := Project_2.Extends;
2611
            end loop Big_Loop;
2612
 
2613
            if Source = No_Source then
2614
               Error_Msg_File_1 := File_Name_Type (Element.Value);
2615
               Error_Msg_Name_1 := Project.Name;
2616
 
2617
               Error_Msg
2618
                 (Data.Flags,
2619
                  "{ cannot be an interface of project %% "
2620
                  & "as it is not one of its sources",
2621
                  Element.Location, Project);
2622
            end if;
2623
 
2624
            List := Element.Next;
2625
         end loop;
2626
 
2627
         Project.Interfaces_Defined := True;
2628
 
2629
      elsif Project.Library and then not Library_Interface.Default then
2630
 
2631
         --  Set In_Interfaces to False for all sources. It will be set to True
2632
         --  later for the sources in the Library_Interface list.
2633
 
2634
         Project_2 := Project;
2635
         while Project_2 /= No_Project loop
2636
            Iter := For_Each_Source (Data.Tree, Project_2);
2637
            loop
2638
               Source := Prj.Element (Iter);
2639
               exit when Source = No_Source;
2640
               Source.In_Interfaces := False;
2641
               Next (Iter);
2642
            end loop;
2643
 
2644
            Project_2 := Project_2.Extends;
2645
         end loop;
2646
 
2647
         List := Library_Interface.Values;
2648
         while List /= Nil_String loop
2649
            Element := Data.Tree.String_Elements.Table (List);
2650
            Get_Name_String (Element.Value);
2651
            To_Lower (Name_Buffer (1 .. Name_Len));
2652
            Name := Name_Find;
2653
 
2654
            Project_2 := Project;
2655
            Big_Loop_2 :
2656
            while Project_2 /= No_Project loop
2657
               Iter := For_Each_Source (Data.Tree, Project_2);
2658
 
2659
               loop
2660
                  Source := Prj.Element (Iter);
2661
                  exit when Source = No_Source;
2662
 
2663
                  if Source.Unit /= No_Unit_Index and then
2664
                     Source.Unit.Name = Name_Id (Name)
2665
                  then
2666
                     if not Source.Locally_Removed then
2667
                        Source.In_Interfaces := True;
2668
                        Source.Declared_In_Interfaces := True;
2669
 
2670
                        Other := Other_Part (Source);
2671
 
2672
                        if Other /= No_Source then
2673
                           Other.In_Interfaces := True;
2674
                           Other.Declared_In_Interfaces := True;
2675
                        end if;
2676
 
2677
                        if Current_Verbosity = High then
2678
                           Write_Str ("   interface: ");
2679
                           Write_Line (Get_Name_String (Source.Path.Name));
2680
                        end if;
2681
                     end if;
2682
 
2683
                     exit Big_Loop_2;
2684
                  end if;
2685
 
2686
                  Next (Iter);
2687
               end loop;
2688
 
2689
               Project_2 := Project_2.Extends;
2690
            end loop Big_Loop_2;
2691
 
2692
            List := Element.Next;
2693
         end loop;
2694
 
2695
         Project.Interfaces_Defined := True;
2696
 
2697
      elsif Project.Extends /= No_Project
2698
        and then Project.Extends.Interfaces_Defined
2699
      then
2700
         Project.Interfaces_Defined := True;
2701
 
2702
         Iter := For_Each_Source (Data.Tree, Project);
2703
         loop
2704
            Source := Prj.Element (Iter);
2705
            exit when Source = No_Source;
2706
 
2707
            if not Source.Declared_In_Interfaces then
2708
               Source.In_Interfaces := False;
2709
            end if;
2710
 
2711
            Next (Iter);
2712
         end loop;
2713
      end if;
2714
   end Check_Interfaces;
2715
 
2716
   --------------------------
2717
   -- Check_Package_Naming --
2718
   --------------------------
2719
 
2720
   procedure Check_Package_Naming
2721
     (Project : Project_Id;
2722
      Data    : in out Tree_Processing_Data;
2723
      Bodies  : out Array_Element_Id;
2724
      Specs   : out Array_Element_Id)
2725
   is
2726
      Naming_Id : constant Package_Id :=
2727
                    Util.Value_Of
2728
                      (Name_Naming, Project.Decl.Packages, Data.Tree);
2729
      Naming    : Package_Element;
2730
 
2731
      Ada_Body_Suffix_Loc : Source_Ptr := No_Location;
2732
 
2733
      procedure Check_Naming;
2734
      --  Check the validity of the Naming package (suffixes valid, ...)
2735
 
2736
      procedure Check_Common
2737
        (Dot_Replacement : in out File_Name_Type;
2738
         Casing          : in out Casing_Type;
2739
         Casing_Defined  : out Boolean;
2740
         Separate_Suffix : in out File_Name_Type;
2741
         Sep_Suffix_Loc  : out Source_Ptr);
2742
      --  Check attributes common
2743
 
2744
      procedure Process_Exceptions_File_Based
2745
        (Lang_Id : Language_Ptr;
2746
         Kind    : Source_Kind);
2747
      procedure Process_Exceptions_Unit_Based
2748
        (Lang_Id : Language_Ptr;
2749
         Kind    : Source_Kind);
2750
      --  Process the naming exceptions for the two types of languages
2751
 
2752
      procedure Initialize_Naming_Data;
2753
      --  Initialize internal naming data for the various languages
2754
 
2755
      ------------------
2756
      -- Check_Common --
2757
      ------------------
2758
 
2759
      procedure Check_Common
2760
        (Dot_Replacement : in out File_Name_Type;
2761
         Casing          : in out Casing_Type;
2762
         Casing_Defined  : out Boolean;
2763
         Separate_Suffix : in out File_Name_Type;
2764
         Sep_Suffix_Loc  : out Source_Ptr)
2765
      is
2766
         Dot_Repl      : constant Variable_Value :=
2767
                           Util.Value_Of
2768
                             (Name_Dot_Replacement,
2769
                              Naming.Decl.Attributes,
2770
                              Data.Tree);
2771
         Casing_String : constant Variable_Value :=
2772
                           Util.Value_Of
2773
                             (Name_Casing,
2774
                              Naming.Decl.Attributes,
2775
                              Data.Tree);
2776
         Sep_Suffix    : constant Variable_Value :=
2777
                           Util.Value_Of
2778
                             (Name_Separate_Suffix,
2779
                              Naming.Decl.Attributes,
2780
                              Data.Tree);
2781
         Dot_Repl_Loc  : Source_Ptr;
2782
 
2783
      begin
2784
         Sep_Suffix_Loc := No_Location;
2785
 
2786
         if not Dot_Repl.Default then
2787
            pragma Assert
2788
              (Dot_Repl.Kind = Single, "Dot_Replacement is not a string");
2789
 
2790
            if Length_Of_Name (Dot_Repl.Value) = 0 then
2791
               Error_Msg
2792
                 (Data.Flags, "Dot_Replacement cannot be empty",
2793
                  Dot_Repl.Location, Project);
2794
            end if;
2795
 
2796
            Dot_Replacement := Canonical_Case_File_Name (Dot_Repl.Value);
2797
            Dot_Repl_Loc    := Dot_Repl.Location;
2798
 
2799
            declare
2800
               Repl : constant String := Get_Name_String (Dot_Replacement);
2801
 
2802
            begin
2803
               --  Dot_Replacement cannot
2804
               --   - be empty
2805
               --   - start or end with an alphanumeric
2806
               --   - be a single '_'
2807
               --   - start with an '_' followed by an alphanumeric
2808
               --   - contain a '.' except if it is "."
2809
 
2810
               if Repl'Length = 0
2811
                 or else Is_Alphanumeric (Repl (Repl'First))
2812
                 or else Is_Alphanumeric (Repl (Repl'Last))
2813
                 or else (Repl (Repl'First) = '_'
2814
                           and then
2815
                             (Repl'Length = 1
2816
                               or else
2817
                                 Is_Alphanumeric (Repl (Repl'First + 1))))
2818
                 or else (Repl'Length > 1
2819
                           and then
2820
                             Index (Source => Repl, Pattern => ".") /= 0)
2821
               then
2822
                  Error_Msg
2823
                    (Data.Flags,
2824
                     '"' & Repl &
2825
                     """ is illegal for Dot_Replacement.",
2826
                     Dot_Repl_Loc, Project);
2827
               end if;
2828
            end;
2829
         end if;
2830
 
2831
         if Dot_Replacement /= No_File then
2832
            Write_Attr
2833
              ("Dot_Replacement", Get_Name_String (Dot_Replacement));
2834
         end if;
2835
 
2836
         Casing_Defined := False;
2837
 
2838
         if not Casing_String.Default then
2839
            pragma Assert
2840
              (Casing_String.Kind = Single, "Casing is not a string");
2841
 
2842
            declare
2843
               Casing_Image : constant String :=
2844
                                Get_Name_String (Casing_String.Value);
2845
 
2846
            begin
2847
               if Casing_Image'Length = 0 then
2848
                  Error_Msg
2849
                    (Data.Flags,
2850
                     "Casing cannot be an empty string",
2851
                     Casing_String.Location, Project);
2852
               end if;
2853
 
2854
               Casing := Value (Casing_Image);
2855
               Casing_Defined := True;
2856
 
2857
            exception
2858
               when Constraint_Error =>
2859
                  Name_Len := Casing_Image'Length;
2860
                  Name_Buffer (1 .. Name_Len) := Casing_Image;
2861
                  Err_Vars.Error_Msg_Name_1 := Name_Find;
2862
                  Error_Msg
2863
                    (Data.Flags,
2864
                     "%% is not a correct Casing",
2865
                     Casing_String.Location, Project);
2866
            end;
2867
         end if;
2868
 
2869
         Write_Attr ("Casing", Image (Casing));
2870
 
2871
         if not Sep_Suffix.Default then
2872
            if Length_Of_Name (Sep_Suffix.Value) = 0 then
2873
               Error_Msg
2874
                 (Data.Flags,
2875
                  "Separate_Suffix cannot be empty",
2876
                  Sep_Suffix.Location, Project);
2877
 
2878
            else
2879
               Separate_Suffix := Canonical_Case_File_Name (Sep_Suffix.Value);
2880
               Sep_Suffix_Loc  := Sep_Suffix.Location;
2881
 
2882
               Check_Illegal_Suffix
2883
                 (Project, Separate_Suffix,
2884
                  Dot_Replacement, "Separate_Suffix", Sep_Suffix.Location,
2885
                  Data);
2886
            end if;
2887
         end if;
2888
 
2889
         if Separate_Suffix /= No_File then
2890
            Write_Attr
2891
              ("Separate_Suffix", Get_Name_String (Separate_Suffix));
2892
         end if;
2893
      end Check_Common;
2894
 
2895
      -----------------------------------
2896
      -- Process_Exceptions_File_Based --
2897
      -----------------------------------
2898
 
2899
      procedure Process_Exceptions_File_Based
2900
        (Lang_Id : Language_Ptr;
2901
         Kind    : Source_Kind)
2902
      is
2903
         Lang           : constant Name_Id := Lang_Id.Name;
2904
         Exceptions     : Array_Element_Id;
2905
         Exception_List : Variable_Value;
2906
         Element_Id     : String_List_Id;
2907
         Element        : String_Element;
2908
         File_Name      : File_Name_Type;
2909
         Source         : Source_Id;
2910
         Iter           : Source_Iterator;
2911
 
2912
      begin
2913
         case Kind is
2914
            when Impl | Sep =>
2915
               Exceptions :=
2916
                 Value_Of
2917
                   (Name_Implementation_Exceptions,
2918
                    In_Arrays => Naming.Decl.Arrays,
2919
                    In_Tree   => Data.Tree);
2920
 
2921
            when Spec =>
2922
               Exceptions :=
2923
                 Value_Of
2924
                   (Name_Specification_Exceptions,
2925
                    In_Arrays => Naming.Decl.Arrays,
2926
                    In_Tree   => Data.Tree);
2927
         end case;
2928
 
2929
         Exception_List := Value_Of
2930
           (Index    => Lang,
2931
            In_Array => Exceptions,
2932
            In_Tree  => Data.Tree);
2933
 
2934
         if Exception_List /= Nil_Variable_Value then
2935
            Element_Id := Exception_List.Values;
2936
            while Element_Id /= Nil_String loop
2937
               Element   := Data.Tree.String_Elements.Table (Element_Id);
2938
               File_Name := Canonical_Case_File_Name (Element.Value);
2939
 
2940
               Iter := For_Each_Source (Data.Tree, Project);
2941
               loop
2942
                  Source := Prj.Element (Iter);
2943
                  exit when Source = No_Source or else Source.File = File_Name;
2944
                  Next (Iter);
2945
               end loop;
2946
 
2947
               if Source = No_Source then
2948
                  Add_Source
2949
                    (Id               => Source,
2950
                     Data             => Data,
2951
                     Project          => Project,
2952
                     Source_Dir_Rank  => 0,
2953
                     Lang_Id          => Lang_Id,
2954
                     Kind             => Kind,
2955
                     File_Name        => File_Name,
2956
                     Display_File     => File_Name_Type (Element.Value),
2957
                     Naming_Exception => True);
2958
 
2959
               else
2960
                  --  Check if the file name is already recorded for another
2961
                  --  language or another kind.
2962
 
2963
                  if Source.Language /= Lang_Id then
2964
                     Error_Msg
2965
                       (Data.Flags,
2966
                        "the same file cannot be a source of two languages",
2967
                        Element.Location, Project);
2968
 
2969
                  elsif Source.Kind /= Kind then
2970
                     Error_Msg
2971
                       (Data.Flags,
2972
                        "the same file cannot be a source and a template",
2973
                        Element.Location, Project);
2974
                  end if;
2975
 
2976
                  --  If the file is already recorded for the same
2977
                  --  language and the same kind, it means that the file
2978
                  --  name appears several times in the *_Exceptions
2979
                  --  attribute; so there is nothing to do.
2980
               end if;
2981
 
2982
               Element_Id := Element.Next;
2983
            end loop;
2984
         end if;
2985
      end Process_Exceptions_File_Based;
2986
 
2987
      -----------------------------------
2988
      -- Process_Exceptions_Unit_Based --
2989
      -----------------------------------
2990
 
2991
      procedure Process_Exceptions_Unit_Based
2992
        (Lang_Id : Language_Ptr;
2993
         Kind    : Source_Kind)
2994
      is
2995
         Lang       : constant Name_Id := Lang_Id.Name;
2996
         Exceptions : Array_Element_Id;
2997
         Element    : Array_Element;
2998
         Unit       : Name_Id;
2999
         Index      : Int;
3000
         File_Name  : File_Name_Type;
3001
         Source     : Source_Id;
3002
 
3003
      begin
3004
         case Kind is
3005
            when Impl | Sep =>
3006
               Exceptions :=
3007
                 Value_Of
3008
                   (Name_Body,
3009
                    In_Arrays => Naming.Decl.Arrays,
3010
                    In_Tree   => Data.Tree);
3011
 
3012
               if Exceptions = No_Array_Element then
3013
                  Exceptions :=
3014
                    Value_Of
3015
                      (Name_Implementation,
3016
                       In_Arrays => Naming.Decl.Arrays,
3017
                       In_Tree   => Data.Tree);
3018
               end if;
3019
 
3020
            when Spec =>
3021
               Exceptions :=
3022
                 Value_Of
3023
                   (Name_Spec,
3024
                    In_Arrays => Naming.Decl.Arrays,
3025
                    In_Tree   => Data.Tree);
3026
 
3027
               if Exceptions = No_Array_Element then
3028
                  Exceptions :=
3029
                    Value_Of
3030
                      (Name_Spec,
3031
                       In_Arrays => Naming.Decl.Arrays,
3032
                       In_Tree   => Data.Tree);
3033
               end if;
3034
         end case;
3035
 
3036
         while Exceptions /= No_Array_Element loop
3037
            Element   := Data.Tree.Array_Elements.Table (Exceptions);
3038
            File_Name := Canonical_Case_File_Name (Element.Value.Value);
3039
 
3040
            Get_Name_String (Element.Index);
3041
            To_Lower (Name_Buffer (1 .. Name_Len));
3042
            Unit  := Name_Find;
3043
            Index := Element.Value.Index;
3044
 
3045
            --  For Ada, check if it is a valid unit name
3046
 
3047
            if Lang = Name_Ada then
3048
               Get_Name_String (Element.Index);
3049
               Check_Ada_Name (Name_Buffer (1 .. Name_Len), Unit);
3050
 
3051
               if Unit = No_Name then
3052
                  Err_Vars.Error_Msg_Name_1 := Element.Index;
3053
                  Error_Msg
3054
                    (Data.Flags,
3055
                     "%% is not a valid unit name.",
3056
                     Element.Value.Location, Project);
3057
               end if;
3058
            end if;
3059
 
3060
            if Unit /= No_Name then
3061
               Add_Source
3062
                 (Id               => Source,
3063
                  Data             => Data,
3064
                  Project          => Project,
3065
                  Source_Dir_Rank  => 0,
3066
                  Lang_Id          => Lang_Id,
3067
                  Kind             => Kind,
3068
                  File_Name        => File_Name,
3069
                  Display_File     => File_Name_Type (Element.Value.Value),
3070
                  Unit             => Unit,
3071
                  Index            => Index,
3072
                  Location         => Element.Value.Location,
3073
                  Naming_Exception => True);
3074
            end if;
3075
 
3076
            Exceptions := Element.Next;
3077
         end loop;
3078
      end Process_Exceptions_Unit_Based;
3079
 
3080
      ------------------
3081
      -- Check_Naming --
3082
      ------------------
3083
 
3084
      procedure Check_Naming is
3085
         Dot_Replacement : File_Name_Type :=
3086
                             File_Name_Type
3087
                               (First_Name_Id + Character'Pos ('-'));
3088
         Separate_Suffix : File_Name_Type := No_File;
3089
         Casing          : Casing_Type    := All_Lower_Case;
3090
         Casing_Defined  : Boolean;
3091
         Lang_Id         : Language_Ptr;
3092
         Sep_Suffix_Loc  : Source_Ptr;
3093
         Suffix          : Variable_Value;
3094
         Lang            : Name_Id;
3095
 
3096
      begin
3097
         Check_Common
3098
           (Dot_Replacement => Dot_Replacement,
3099
            Casing          => Casing,
3100
            Casing_Defined  => Casing_Defined,
3101
            Separate_Suffix => Separate_Suffix,
3102
            Sep_Suffix_Loc  => Sep_Suffix_Loc);
3103
 
3104
         --  For all unit based languages, if any, set the specified value
3105
         --  of Dot_Replacement, Casing and/or Separate_Suffix. Do not
3106
         --  systematically overwrite, since the defaults come from the
3107
         --  configuration file.
3108
 
3109
         if Dot_Replacement /= No_File
3110
           or else Casing_Defined
3111
           or else Separate_Suffix /= No_File
3112
         then
3113
            Lang_Id := Project.Languages;
3114
            while Lang_Id /= No_Language_Index loop
3115
               if Lang_Id.Config.Kind = Unit_Based then
3116
                  if Dot_Replacement /= No_File then
3117
                     Lang_Id.Config.Naming_Data.Dot_Replacement :=
3118
                         Dot_Replacement;
3119
                  end if;
3120
 
3121
                  if Casing_Defined then
3122
                     Lang_Id.Config.Naming_Data.Casing := Casing;
3123
                  end if;
3124
               end if;
3125
 
3126
               Lang_Id := Lang_Id.Next;
3127
            end loop;
3128
         end if;
3129
 
3130
         --  Next, get the spec and body suffixes
3131
 
3132
         Lang_Id := Project.Languages;
3133
         while Lang_Id /= No_Language_Index loop
3134
            Lang := Lang_Id.Name;
3135
 
3136
            --  Spec_Suffix
3137
 
3138
            Suffix := Value_Of
3139
              (Name                    => Lang,
3140
               Attribute_Or_Array_Name => Name_Spec_Suffix,
3141
               In_Package              => Naming_Id,
3142
               In_Tree                 => Data.Tree);
3143
 
3144
            if Suffix = Nil_Variable_Value then
3145
               Suffix := Value_Of
3146
                 (Name                    => Lang,
3147
                  Attribute_Or_Array_Name => Name_Specification_Suffix,
3148
                  In_Package              => Naming_Id,
3149
                  In_Tree                 => Data.Tree);
3150
            end if;
3151
 
3152
            if Suffix /= Nil_Variable_Value then
3153
               Lang_Id.Config.Naming_Data.Spec_Suffix :=
3154
                   File_Name_Type (Suffix.Value);
3155
 
3156
               Check_Illegal_Suffix
3157
                 (Project,
3158
                  Lang_Id.Config.Naming_Data.Spec_Suffix,
3159
                  Lang_Id.Config.Naming_Data.Dot_Replacement,
3160
                  "Spec_Suffix", Suffix.Location, Data);
3161
 
3162
               Write_Attr
3163
                 ("Spec_Suffix",
3164
                  Get_Name_String (Lang_Id.Config.Naming_Data.Spec_Suffix));
3165
            end if;
3166
 
3167
            --  Body_Suffix
3168
 
3169
            Suffix :=
3170
              Value_Of
3171
                (Name                    => Lang,
3172
                 Attribute_Or_Array_Name => Name_Body_Suffix,
3173
                 In_Package              => Naming_Id,
3174
                 In_Tree                 => Data.Tree);
3175
 
3176
            if Suffix = Nil_Variable_Value then
3177
               Suffix :=
3178
                 Value_Of
3179
                   (Name                    => Lang,
3180
                    Attribute_Or_Array_Name => Name_Implementation_Suffix,
3181
                    In_Package              => Naming_Id,
3182
                    In_Tree                 => Data.Tree);
3183
            end if;
3184
 
3185
            if Suffix /= Nil_Variable_Value then
3186
               Lang_Id.Config.Naming_Data.Body_Suffix :=
3187
                 File_Name_Type (Suffix.Value);
3188
 
3189
               --  The default value of separate suffix should be the same as
3190
               --  the body suffix, so we need to compute that first.
3191
 
3192
               if Separate_Suffix = No_File then
3193
                  Lang_Id.Config.Naming_Data.Separate_Suffix :=
3194
                    Lang_Id.Config.Naming_Data.Body_Suffix;
3195
                  Write_Attr
3196
                    ("Sep_Suffix",
3197
                     Get_Name_String
3198
                       (Lang_Id.Config.Naming_Data.Separate_Suffix));
3199
               else
3200
                  Lang_Id.Config.Naming_Data.Separate_Suffix :=
3201
                    Separate_Suffix;
3202
               end if;
3203
 
3204
               Check_Illegal_Suffix
3205
                 (Project,
3206
                  Lang_Id.Config.Naming_Data.Body_Suffix,
3207
                  Lang_Id.Config.Naming_Data.Dot_Replacement,
3208
                  "Body_Suffix", Suffix.Location, Data);
3209
 
3210
               Write_Attr
3211
                 ("Body_Suffix",
3212
                  Get_Name_String (Lang_Id.Config.Naming_Data.Body_Suffix));
3213
 
3214
            elsif Separate_Suffix /= No_File then
3215
               Lang_Id.Config.Naming_Data.Separate_Suffix := Separate_Suffix;
3216
            end if;
3217
 
3218
            --  Spec_Suffix cannot be equal to Body_Suffix or Separate_Suffix,
3219
            --  since that would cause a clear ambiguity. Note that we do allow
3220
            --  a Spec_Suffix to have the same termination as one of these,
3221
            --  which causes a potential ambiguity, but we resolve that my
3222
            --  matching the longest possible suffix.
3223
 
3224
            if Lang_Id.Config.Naming_Data.Spec_Suffix /= No_File
3225
              and then Lang_Id.Config.Naming_Data.Spec_Suffix =
3226
                       Lang_Id.Config.Naming_Data.Body_Suffix
3227
            then
3228
               Error_Msg
3229
                 (Data.Flags,
3230
                  "Body_Suffix ("""
3231
                  & Get_Name_String (Lang_Id.Config.Naming_Data.Body_Suffix)
3232
                  & """) cannot be the same as Spec_Suffix.",
3233
                  Ada_Body_Suffix_Loc, Project);
3234
            end if;
3235
 
3236
            if Lang_Id.Config.Naming_Data.Body_Suffix /=
3237
               Lang_Id.Config.Naming_Data.Separate_Suffix
3238
              and then Lang_Id.Config.Naming_Data.Spec_Suffix =
3239
                       Lang_Id.Config.Naming_Data.Separate_Suffix
3240
            then
3241
               Error_Msg
3242
                 (Data.Flags,
3243
                  "Separate_Suffix ("""
3244
                  & Get_Name_String
3245
                    (Lang_Id.Config.Naming_Data.Separate_Suffix)
3246
                  & """) cannot be the same as Spec_Suffix.",
3247
                  Sep_Suffix_Loc, Project);
3248
            end if;
3249
 
3250
            Lang_Id := Lang_Id.Next;
3251
         end loop;
3252
 
3253
         --  Get the naming exceptions for all languages
3254
 
3255
         for Kind in Spec .. Impl loop
3256
            Lang_Id := Project.Languages;
3257
            while Lang_Id /= No_Language_Index loop
3258
               case Lang_Id.Config.Kind is
3259
                  when File_Based =>
3260
                     Process_Exceptions_File_Based (Lang_Id, Kind);
3261
 
3262
                  when Unit_Based =>
3263
                     Process_Exceptions_Unit_Based (Lang_Id, Kind);
3264
               end case;
3265
 
3266
               Lang_Id := Lang_Id.Next;
3267
            end loop;
3268
         end loop;
3269
      end Check_Naming;
3270
 
3271
      ----------------------------
3272
      -- Initialize_Naming_Data --
3273
      ----------------------------
3274
 
3275
      procedure Initialize_Naming_Data is
3276
         Specs : Array_Element_Id :=
3277
                   Util.Value_Of
3278
                     (Name_Spec_Suffix,
3279
                      Naming.Decl.Arrays,
3280
                      Data.Tree);
3281
 
3282
         Impls : Array_Element_Id :=
3283
                   Util.Value_Of
3284
                     (Name_Body_Suffix,
3285
                      Naming.Decl.Arrays,
3286
                      Data.Tree);
3287
 
3288
         Lang      : Language_Ptr;
3289
         Lang_Name : Name_Id;
3290
         Value     : Variable_Value;
3291
         Extended  : Project_Id;
3292
 
3293
      begin
3294
         --  At this stage, the project already contains the default extensions
3295
         --  for the various languages. We now merge those suffixes read in the
3296
         --  user project, and they override the default.
3297
 
3298
         while Specs /= No_Array_Element loop
3299
            Lang_Name := Data.Tree.Array_Elements.Table (Specs).Index;
3300
            Lang :=
3301
              Get_Language_From_Name
3302
                (Project, Name => Get_Name_String (Lang_Name));
3303
 
3304
            --  An extending project inherits its parent projects' languages
3305
            --  so if needed we should create entries for those languages
3306
 
3307
            if Lang = null  then
3308
               Extended := Project.Extends;
3309
               while Extended /= null loop
3310
                  Lang := Get_Language_From_Name
3311
                    (Extended, Name => Get_Name_String (Lang_Name));
3312
                  exit when Lang /= null;
3313
 
3314
                  Extended := Extended.Extends;
3315
               end loop;
3316
 
3317
               if Lang /= null then
3318
                  Lang := new Language_Data'(Lang.all);
3319
                  Lang.First_Source := null;
3320
                  Lang.Next := Project.Languages;
3321
                  Project.Languages := Lang;
3322
               end if;
3323
            end if;
3324
 
3325
            --  If language was not found in project or the projects it extends
3326
 
3327
            if Lang = null then
3328
               if Current_Verbosity = High then
3329
                  Write_Line
3330
                    ("Ignoring spec naming data for "
3331
                     & Get_Name_String (Lang_Name)
3332
                     & " since language is not defined for this project");
3333
               end if;
3334
 
3335
            else
3336
               Value := Data.Tree.Array_Elements.Table (Specs).Value;
3337
 
3338
               if Value.Kind = Single then
3339
                  Lang.Config.Naming_Data.Spec_Suffix :=
3340
                    Canonical_Case_File_Name (Value.Value);
3341
               end if;
3342
            end if;
3343
 
3344
            Specs := Data.Tree.Array_Elements.Table (Specs).Next;
3345
         end loop;
3346
 
3347
         while Impls /= No_Array_Element loop
3348
            Lang_Name := Data.Tree.Array_Elements.Table (Impls).Index;
3349
            Lang :=
3350
              Get_Language_From_Name
3351
                (Project, Name => Get_Name_String (Lang_Name));
3352
 
3353
            if Lang = null then
3354
               if Current_Verbosity = High then
3355
                  Write_Line
3356
                    ("Ignoring impl naming data for "
3357
                     & Get_Name_String (Lang_Name)
3358
                     & " since language is not defined for this project");
3359
               end if;
3360
            else
3361
               Value := Data.Tree.Array_Elements.Table (Impls).Value;
3362
 
3363
               if Lang.Name = Name_Ada then
3364
                  Ada_Body_Suffix_Loc := Value.Location;
3365
               end if;
3366
 
3367
               if Value.Kind = Single then
3368
                  Lang.Config.Naming_Data.Body_Suffix :=
3369
                    Canonical_Case_File_Name (Value.Value);
3370
               end if;
3371
            end if;
3372
 
3373
            Impls := Data.Tree.Array_Elements.Table (Impls).Next;
3374
         end loop;
3375
      end Initialize_Naming_Data;
3376
 
3377
   --  Start of processing for Check_Naming_Schemes
3378
 
3379
   begin
3380
      Specs  := No_Array_Element;
3381
      Bodies := No_Array_Element;
3382
 
3383
      --  No Naming package or parsing a configuration file? nothing to do
3384
 
3385
      if Naming_Id /= No_Package
3386
        and then Project.Qualifier /= Configuration
3387
      then
3388
         Naming := Data.Tree.Packages.Table (Naming_Id);
3389
 
3390
         if Current_Verbosity = High then
3391
            Write_Line ("Checking package Naming for project "
3392
                        & Get_Name_String (Project.Name));
3393
         end if;
3394
 
3395
         Initialize_Naming_Data;
3396
         Check_Naming;
3397
      end if;
3398
   end Check_Package_Naming;
3399
 
3400
   ------------------------------
3401
   -- Check_Library_Attributes --
3402
   ------------------------------
3403
 
3404
   procedure Check_Library_Attributes
3405
     (Project : Project_Id;
3406
      Data    : in out Tree_Processing_Data)
3407
   is
3408
      Attributes   : constant Prj.Variable_Id := Project.Decl.Attributes;
3409
 
3410
      Lib_Dir      : constant Prj.Variable_Value :=
3411
                       Prj.Util.Value_Of
3412
                         (Snames.Name_Library_Dir, Attributes, Data.Tree);
3413
 
3414
      Lib_Name     : constant Prj.Variable_Value :=
3415
                       Prj.Util.Value_Of
3416
                         (Snames.Name_Library_Name, Attributes, Data.Tree);
3417
 
3418
      Lib_Version  : constant Prj.Variable_Value :=
3419
                       Prj.Util.Value_Of
3420
                         (Snames.Name_Library_Version, Attributes, Data.Tree);
3421
 
3422
      Lib_ALI_Dir  : constant Prj.Variable_Value :=
3423
                       Prj.Util.Value_Of
3424
                         (Snames.Name_Library_Ali_Dir, Attributes, Data.Tree);
3425
 
3426
      Lib_GCC      : constant Prj.Variable_Value :=
3427
                       Prj.Util.Value_Of
3428
                         (Snames.Name_Library_GCC, Attributes, Data.Tree);
3429
 
3430
      The_Lib_Kind : constant Prj.Variable_Value :=
3431
                       Prj.Util.Value_Of
3432
                         (Snames.Name_Library_Kind, Attributes, Data.Tree);
3433
 
3434
      Imported_Project_List : Project_List;
3435
 
3436
      Continuation : String_Access := No_Continuation_String'Access;
3437
 
3438
      Support_For_Libraries : Library_Support;
3439
 
3440
      Library_Directory_Present : Boolean;
3441
 
3442
      procedure Check_Library (Proj : Project_Id; Extends : Boolean);
3443
      --  Check if an imported or extended project if also a library project
3444
 
3445
      -------------------
3446
      -- Check_Library --
3447
      -------------------
3448
 
3449
      procedure Check_Library (Proj : Project_Id; Extends : Boolean) is
3450
         Src_Id : Source_Id;
3451
         Iter   : Source_Iterator;
3452
 
3453
      begin
3454
         if Proj /= No_Project then
3455
            if not Proj.Library then
3456
 
3457
               --  The only not library projects that are OK are those that
3458
               --  have no sources. However, header files from non-Ada
3459
               --  languages are OK, as there is nothing to compile.
3460
 
3461
               Iter := For_Each_Source (Data.Tree, Proj);
3462
               loop
3463
                  Src_Id := Prj.Element (Iter);
3464
                  exit when Src_Id = No_Source
3465
                    or else Src_Id.Language.Config.Kind /= File_Based
3466
                    or else Src_Id.Kind /= Spec;
3467
                  Next (Iter);
3468
               end loop;
3469
 
3470
               if Src_Id /= No_Source then
3471
                  Error_Msg_Name_1 := Project.Name;
3472
                  Error_Msg_Name_2 := Proj.Name;
3473
 
3474
                  if Extends then
3475
                     if Project.Library_Kind /= Static then
3476
                        Error_Msg
3477
                          (Data.Flags,
3478
                           Continuation.all &
3479
                           "shared library project %% cannot extend " &
3480
                           "project %% that is not a library project",
3481
                           Project.Location, Project);
3482
                        Continuation := Continuation_String'Access;
3483
                     end if;
3484
 
3485
                  elsif (not Unchecked_Shared_Lib_Imports)
3486
                        and then Project.Library_Kind /= Static
3487
                  then
3488
                     Error_Msg
3489
                       (Data.Flags,
3490
                        Continuation.all &
3491
                        "shared library project %% cannot import project %% " &
3492
                        "that is not a shared library project",
3493
                        Project.Location, Project);
3494
                     Continuation := Continuation_String'Access;
3495
                  end if;
3496
               end if;
3497
 
3498
            elsif Project.Library_Kind /= Static and then
3499
                  Proj.Library_Kind = Static
3500
            then
3501
               Error_Msg_Name_1 := Project.Name;
3502
               Error_Msg_Name_2 := Proj.Name;
3503
 
3504
               if Extends then
3505
                  Error_Msg
3506
                    (Data.Flags,
3507
                     Continuation.all &
3508
                     "shared library project %% cannot extend static " &
3509
                     "library project %%",
3510
                     Project.Location, Project);
3511
                  Continuation := Continuation_String'Access;
3512
 
3513
               elsif not Unchecked_Shared_Lib_Imports then
3514
                  Error_Msg
3515
                    (Data.Flags,
3516
                     Continuation.all &
3517
                     "shared library project %% cannot import static " &
3518
                     "library project %%",
3519
                     Project.Location, Project);
3520
                  Continuation := Continuation_String'Access;
3521
               end if;
3522
 
3523
            end if;
3524
         end if;
3525
      end Check_Library;
3526
 
3527
      Dir_Exists : Boolean;
3528
 
3529
   --  Start of processing for Check_Library_Attributes
3530
 
3531
   begin
3532
      Library_Directory_Present := Lib_Dir.Value /= Empty_String;
3533
 
3534
      --  Special case of extending project
3535
 
3536
      if Project.Extends /= No_Project then
3537
 
3538
         --  If the project extended is a library project, we inherit the
3539
         --  library name, if it is not redefined; we check that the library
3540
         --  directory is specified.
3541
 
3542
         if Project.Extends.Library then
3543
            if Project.Qualifier = Standard then
3544
               Error_Msg
3545
                 (Data.Flags,
3546
                  "a standard project cannot extend a library project",
3547
                  Project.Location, Project);
3548
 
3549
            else
3550
               if Lib_Name.Default then
3551
                  Project.Library_Name := Project.Extends.Library_Name;
3552
               end if;
3553
 
3554
               if Lib_Dir.Default then
3555
                  if not Project.Virtual then
3556
                     Error_Msg
3557
                       (Data.Flags,
3558
                        "a project extending a library project must " &
3559
                        "specify an attribute Library_Dir",
3560
                        Project.Location, Project);
3561
 
3562
                  else
3563
                     --  For a virtual project extending a library project,
3564
                     --  inherit library directory.
3565
 
3566
                     Project.Library_Dir := Project.Extends.Library_Dir;
3567
                     Library_Directory_Present := True;
3568
                  end if;
3569
               end if;
3570
            end if;
3571
         end if;
3572
      end if;
3573
 
3574
      pragma Assert (Lib_Name.Kind = Single);
3575
 
3576
      if Lib_Name.Value = Empty_String then
3577
         if Current_Verbosity = High
3578
           and then Project.Library_Name = No_Name
3579
         then
3580
            Write_Line ("No library name");
3581
         end if;
3582
 
3583
      else
3584
         --  There is no restriction on the syntax of library names
3585
 
3586
         Project.Library_Name := Lib_Name.Value;
3587
      end if;
3588
 
3589
      if Project.Library_Name /= No_Name then
3590
         if Current_Verbosity = High then
3591
            Write_Attr
3592
              ("Library name", Get_Name_String (Project.Library_Name));
3593
         end if;
3594
 
3595
         pragma Assert (Lib_Dir.Kind = Single);
3596
 
3597
         if not Library_Directory_Present then
3598
            if Current_Verbosity = High then
3599
               Write_Line ("No library directory");
3600
            end if;
3601
 
3602
         else
3603
            --  Find path name (unless inherited), check that it is a directory
3604
 
3605
            if Project.Library_Dir = No_Path_Information then
3606
               Locate_Directory
3607
                 (Project,
3608
                  File_Name_Type (Lib_Dir.Value),
3609
                  Path             => Project.Library_Dir,
3610
                  Dir_Exists       => Dir_Exists,
3611
                  Data             => Data,
3612
                  Create           => "library",
3613
                  Must_Exist       => False,
3614
                  Location         => Lib_Dir.Location,
3615
                  Externally_Built => Project.Externally_Built);
3616
 
3617
            else
3618
               Dir_Exists :=
3619
                 Is_Directory
3620
                   (Get_Name_String
3621
                        (Project.Library_Dir.Display_Name));
3622
            end if;
3623
 
3624
            if not Dir_Exists then
3625
 
3626
               --  Get the absolute name of the library directory that
3627
               --  does not exist, to report an error.
3628
 
3629
               Err_Vars.Error_Msg_File_1 :=
3630
                 File_Name_Type (Project.Library_Dir.Display_Name);
3631
               Error_Msg
3632
                 (Data.Flags,
3633
                  "library directory { does not exist",
3634
                  Lib_Dir.Location, Project);
3635
 
3636
               --  The library directory cannot be the same as the Object
3637
               --  directory.
3638
 
3639
            elsif Project.Library_Dir.Name = Project.Object_Directory.Name then
3640
               Error_Msg
3641
                 (Data.Flags,
3642
                  "library directory cannot be the same " &
3643
                  "as object directory",
3644
                  Lib_Dir.Location, Project);
3645
               Project.Library_Dir := No_Path_Information;
3646
 
3647
            else
3648
               declare
3649
                  OK       : Boolean := True;
3650
                  Dirs_Id  : String_List_Id;
3651
                  Dir_Elem : String_Element;
3652
                  Pid      : Project_List;
3653
 
3654
               begin
3655
                  --  The library directory cannot be the same as a source
3656
                  --  directory of the current project.
3657
 
3658
                  Dirs_Id := Project.Source_Dirs;
3659
                  while Dirs_Id /= Nil_String loop
3660
                     Dir_Elem := Data.Tree.String_Elements.Table (Dirs_Id);
3661
                     Dirs_Id  := Dir_Elem.Next;
3662
 
3663
                     if Project.Library_Dir.Name =
3664
                       Path_Name_Type (Dir_Elem.Value)
3665
                     then
3666
                        Err_Vars.Error_Msg_File_1 :=
3667
                          File_Name_Type (Dir_Elem.Value);
3668
                        Error_Msg
3669
                          (Data.Flags,
3670
                           "library directory cannot be the same " &
3671
                           "as source directory {",
3672
                           Lib_Dir.Location, Project);
3673
                        OK := False;
3674
                        exit;
3675
                     end if;
3676
                  end loop;
3677
 
3678
                  if OK then
3679
 
3680
                     --  The library directory cannot be the same as a source
3681
                     --  directory of another project either.
3682
 
3683
                     Pid := Data.Tree.Projects;
3684
                     Project_Loop : loop
3685
                        exit Project_Loop when Pid = null;
3686
 
3687
                        if Pid.Project /= Project then
3688
                           Dirs_Id := Pid.Project.Source_Dirs;
3689
 
3690
                           Dir_Loop : while Dirs_Id /= Nil_String loop
3691
                              Dir_Elem :=
3692
                                Data.Tree.String_Elements.Table (Dirs_Id);
3693
                              Dirs_Id  := Dir_Elem.Next;
3694
 
3695
                              if Project.Library_Dir.Name =
3696
                                Path_Name_Type (Dir_Elem.Value)
3697
                              then
3698
                                 Err_Vars.Error_Msg_File_1 :=
3699
                                   File_Name_Type (Dir_Elem.Value);
3700
                                 Err_Vars.Error_Msg_Name_1 := Pid.Project.Name;
3701
 
3702
                                 Error_Msg
3703
                                   (Data.Flags,
3704
                                    "library directory cannot be the same " &
3705
                                    "as source directory { of project %%",
3706
                                    Lib_Dir.Location, Project);
3707
                                 OK := False;
3708
                                 exit Project_Loop;
3709
                              end if;
3710
                           end loop Dir_Loop;
3711
                        end if;
3712
 
3713
                        Pid := Pid.Next;
3714
                     end loop Project_Loop;
3715
                  end if;
3716
 
3717
                  if not OK then
3718
                     Project.Library_Dir := No_Path_Information;
3719
 
3720
                  elsif Current_Verbosity = High then
3721
 
3722
                     --  Display the Library directory in high verbosity
3723
 
3724
                     Write_Attr
3725
                       ("Library directory",
3726
                        Get_Name_String (Project.Library_Dir.Display_Name));
3727
                  end if;
3728
               end;
3729
            end if;
3730
         end if;
3731
 
3732
      end if;
3733
 
3734
      Project.Library :=
3735
        Project.Library_Dir /= No_Path_Information
3736
          and then Project.Library_Name /= No_Name;
3737
 
3738
      if Project.Extends = No_Project then
3739
         case Project.Qualifier is
3740
            when Standard =>
3741
               if Project.Library then
3742
                  Error_Msg
3743
                    (Data.Flags,
3744
                     "a standard project cannot be a library project",
3745
                     Lib_Name.Location, Project);
3746
               end if;
3747
 
3748
            when Library =>
3749
               if not Project.Library then
3750
                  if Project.Library_Dir = No_Path_Information then
3751
                     Error_Msg
3752
                       (Data.Flags,
3753
                        "\attribute Library_Dir not declared",
3754
                        Project.Location, Project);
3755
                  end if;
3756
 
3757
                  if Project.Library_Name = No_Name then
3758
                     Error_Msg
3759
                       (Data.Flags,
3760
                        "\attribute Library_Name not declared",
3761
                        Project.Location, Project);
3762
                  end if;
3763
               end if;
3764
 
3765
            when others =>
3766
               null;
3767
 
3768
         end case;
3769
      end if;
3770
 
3771
      if Project.Library then
3772
         Support_For_Libraries := Project.Config.Lib_Support;
3773
 
3774
         if Support_For_Libraries = Prj.None then
3775
            Error_Msg
3776
              (Data.Flags,
3777
               "?libraries are not supported on this platform",
3778
               Lib_Name.Location, Project);
3779
            Project.Library := False;
3780
 
3781
         else
3782
            if Lib_ALI_Dir.Value = Empty_String then
3783
               if Current_Verbosity = High then
3784
                  Write_Line ("No library ALI directory specified");
3785
               end if;
3786
 
3787
               Project.Library_ALI_Dir := Project.Library_Dir;
3788
 
3789
            else
3790
               --  Find path name, check that it is a directory
3791
 
3792
               Locate_Directory
3793
                 (Project,
3794
                  File_Name_Type (Lib_ALI_Dir.Value),
3795
                  Path             => Project.Library_ALI_Dir,
3796
                  Create           => "library ALI",
3797
                  Dir_Exists       => Dir_Exists,
3798
                  Data             => Data,
3799
                  Must_Exist       => False,
3800
                  Location         => Lib_ALI_Dir.Location,
3801
                  Externally_Built => Project.Externally_Built);
3802
 
3803
               if not Dir_Exists then
3804
 
3805
                  --  Get the absolute name of the library ALI directory that
3806
                  --  does not exist, to report an error.
3807
 
3808
                  Err_Vars.Error_Msg_File_1 :=
3809
                    File_Name_Type (Project.Library_ALI_Dir.Display_Name);
3810
                  Error_Msg
3811
                    (Data.Flags,
3812
                     "library 'A'L'I directory { does not exist",
3813
                     Lib_ALI_Dir.Location, Project);
3814
               end if;
3815
 
3816
               if Project.Library_ALI_Dir /= Project.Library_Dir then
3817
 
3818
                  --  The library ALI directory cannot be the same as the
3819
                  --  Object directory.
3820
 
3821
                  if Project.Library_ALI_Dir = Project.Object_Directory then
3822
                     Error_Msg
3823
                       (Data.Flags,
3824
                        "library 'A'L'I directory cannot be the same " &
3825
                        "as object directory",
3826
                        Lib_ALI_Dir.Location, Project);
3827
                     Project.Library_ALI_Dir := No_Path_Information;
3828
 
3829
                  else
3830
                     declare
3831
                        OK       : Boolean := True;
3832
                        Dirs_Id  : String_List_Id;
3833
                        Dir_Elem : String_Element;
3834
                        Pid      : Project_List;
3835
 
3836
                     begin
3837
                        --  The library ALI directory cannot be the same as
3838
                        --  a source directory of the current project.
3839
 
3840
                        Dirs_Id := Project.Source_Dirs;
3841
                        while Dirs_Id /= Nil_String loop
3842
                           Dir_Elem :=
3843
                             Data.Tree.String_Elements.Table (Dirs_Id);
3844
                           Dirs_Id  := Dir_Elem.Next;
3845
 
3846
                           if Project.Library_ALI_Dir.Name =
3847
                             Path_Name_Type (Dir_Elem.Value)
3848
                           then
3849
                              Err_Vars.Error_Msg_File_1 :=
3850
                                File_Name_Type (Dir_Elem.Value);
3851
                              Error_Msg
3852
                                (Data.Flags,
3853
                                 "library 'A'L'I directory cannot be " &
3854
                                 "the same as source directory {",
3855
                                 Lib_ALI_Dir.Location, Project);
3856
                              OK := False;
3857
                              exit;
3858
                           end if;
3859
                        end loop;
3860
 
3861
                        if OK then
3862
 
3863
                           --  The library ALI directory cannot be the same as
3864
                           --  a source directory of another project either.
3865
 
3866
                           Pid := Data.Tree.Projects;
3867
                           ALI_Project_Loop : loop
3868
                              exit ALI_Project_Loop when Pid = null;
3869
 
3870
                              if Pid.Project /= Project then
3871
                                 Dirs_Id := Pid.Project.Source_Dirs;
3872
 
3873
                                 ALI_Dir_Loop :
3874
                                 while Dirs_Id /= Nil_String loop
3875
                                    Dir_Elem :=
3876
                                      Data.Tree.String_Elements.Table
3877
                                        (Dirs_Id);
3878
                                    Dirs_Id  := Dir_Elem.Next;
3879
 
3880
                                    if Project.Library_ALI_Dir.Name =
3881
                                        Path_Name_Type (Dir_Elem.Value)
3882
                                    then
3883
                                       Err_Vars.Error_Msg_File_1 :=
3884
                                         File_Name_Type (Dir_Elem.Value);
3885
                                       Err_Vars.Error_Msg_Name_1 :=
3886
                                         Pid.Project.Name;
3887
 
3888
                                       Error_Msg
3889
                                         (Data.Flags,
3890
                                          "library 'A'L'I directory cannot " &
3891
                                          "be the same as source directory " &
3892
                                          "{ of project %%",
3893
                                          Lib_ALI_Dir.Location, Project);
3894
                                       OK := False;
3895
                                       exit ALI_Project_Loop;
3896
                                    end if;
3897
                                 end loop ALI_Dir_Loop;
3898
                              end if;
3899
                              Pid := Pid.Next;
3900
                           end loop ALI_Project_Loop;
3901
                        end if;
3902
 
3903
                        if not OK then
3904
                           Project.Library_ALI_Dir := No_Path_Information;
3905
 
3906
                        elsif Current_Verbosity = High then
3907
 
3908
                           --  Display Library ALI directory in high verbosity
3909
 
3910
                           Write_Attr
3911
                             ("Library ALI dir",
3912
                              Get_Name_String
3913
                                (Project.Library_ALI_Dir.Display_Name));
3914
                        end if;
3915
                     end;
3916
                  end if;
3917
               end if;
3918
            end if;
3919
 
3920
            pragma Assert (Lib_Version.Kind = Single);
3921
 
3922
            if Lib_Version.Value = Empty_String then
3923
               if Current_Verbosity = High then
3924
                  Write_Line ("No library version specified");
3925
               end if;
3926
 
3927
            else
3928
               Project.Lib_Internal_Name := Lib_Version.Value;
3929
            end if;
3930
 
3931
            pragma Assert (The_Lib_Kind.Kind = Single);
3932
 
3933
            if The_Lib_Kind.Value = Empty_String then
3934
               if Current_Verbosity = High then
3935
                  Write_Line ("No library kind specified");
3936
               end if;
3937
 
3938
            else
3939
               Get_Name_String (The_Lib_Kind.Value);
3940
 
3941
               declare
3942
                  Kind_Name : constant String :=
3943
                                To_Lower (Name_Buffer (1 .. Name_Len));
3944
 
3945
                  OK : Boolean := True;
3946
 
3947
               begin
3948
                  if Kind_Name = "static" then
3949
                     Project.Library_Kind := Static;
3950
 
3951
                  elsif Kind_Name = "dynamic" then
3952
                     Project.Library_Kind := Dynamic;
3953
 
3954
                  elsif Kind_Name = "relocatable" then
3955
                     Project.Library_Kind := Relocatable;
3956
 
3957
                  else
3958
                     Error_Msg
3959
                       (Data.Flags,
3960
                        "illegal value for Library_Kind",
3961
                        The_Lib_Kind.Location, Project);
3962
                     OK := False;
3963
                  end if;
3964
 
3965
                  if Current_Verbosity = High and then OK then
3966
                     Write_Attr ("Library kind", Kind_Name);
3967
                  end if;
3968
 
3969
                  if Project.Library_Kind /= Static then
3970
                     if Support_For_Libraries = Prj.Static_Only then
3971
                        Error_Msg
3972
                          (Data.Flags,
3973
                           "only static libraries are supported " &
3974
                           "on this platform",
3975
                           The_Lib_Kind.Location, Project);
3976
                        Project.Library := False;
3977
 
3978
                     else
3979
                        --  Check if (obsolescent) attribute Library_GCC or
3980
                        --  Linker'Driver is declared.
3981
 
3982
                        if Lib_GCC.Value /= Empty_String then
3983
                           Error_Msg
3984
                             (Data.Flags,
3985
                              "?Library_'G'C'C is an obsolescent attribute, " &
3986
                              "use Linker''Driver instead",
3987
                              Lib_GCC.Location, Project);
3988
                           Project.Config.Shared_Lib_Driver :=
3989
                             File_Name_Type (Lib_GCC.Value);
3990
 
3991
                        else
3992
                           declare
3993
                              Linker : constant Package_Id :=
3994
                                         Value_Of
3995
                                           (Name_Linker,
3996
                                            Project.Decl.Packages,
3997
                                            Data.Tree);
3998
                              Driver : constant Variable_Value :=
3999
                                         Value_Of
4000
                                           (Name                 => No_Name,
4001
                                            Attribute_Or_Array_Name =>
4002
                                              Name_Driver,
4003
                                            In_Package           => Linker,
4004
                                            In_Tree              => Data.Tree);
4005
 
4006
                           begin
4007
                              if Driver /= Nil_Variable_Value
4008
                                 and then Driver.Value /= Empty_String
4009
                              then
4010
                                 Project.Config.Shared_Lib_Driver :=
4011
                                   File_Name_Type (Driver.Value);
4012
                              end if;
4013
                           end;
4014
                        end if;
4015
                     end if;
4016
                  end if;
4017
               end;
4018
            end if;
4019
 
4020
            if Project.Library then
4021
               if Current_Verbosity = High then
4022
                  Write_Line ("This is a library project file");
4023
               end if;
4024
 
4025
               Check_Library (Project.Extends, Extends => True);
4026
 
4027
               Imported_Project_List := Project.Imported_Projects;
4028
               while Imported_Project_List /= null loop
4029
                  Check_Library
4030
                    (Imported_Project_List.Project,
4031
                     Extends => False);
4032
                  Imported_Project_List := Imported_Project_List.Next;
4033
               end loop;
4034
            end if;
4035
 
4036
         end if;
4037
      end if;
4038
 
4039
      --  Check if Linker'Switches or Linker'Default_Switches are declared.
4040
      --  Warn if they are declared, as it is a common error to think that
4041
      --  library are "linked" with Linker switches.
4042
 
4043
      if Project.Library then
4044
         declare
4045
            Linker_Package_Id : constant Package_Id :=
4046
                                  Util.Value_Of
4047
                                    (Name_Linker,
4048
                                     Project.Decl.Packages, Data.Tree);
4049
            Linker_Package    : Package_Element;
4050
            Switches          : Array_Element_Id := No_Array_Element;
4051
 
4052
         begin
4053
            if Linker_Package_Id /= No_Package then
4054
               Linker_Package := Data.Tree.Packages.Table (Linker_Package_Id);
4055
 
4056
               Switches :=
4057
                 Value_Of
4058
                   (Name      => Name_Switches,
4059
                    In_Arrays => Linker_Package.Decl.Arrays,
4060
                    In_Tree   => Data.Tree);
4061
 
4062
               if Switches = No_Array_Element then
4063
                  Switches :=
4064
                    Value_Of
4065
                      (Name      => Name_Default_Switches,
4066
                       In_Arrays => Linker_Package.Decl.Arrays,
4067
                       In_Tree   => Data.Tree);
4068
               end if;
4069
 
4070
               if Switches /= No_Array_Element then
4071
                  Error_Msg
4072
                    (Data.Flags,
4073
                     "?Linker switches not taken into account in library " &
4074
                     "projects",
4075
                     No_Location, Project);
4076
               end if;
4077
            end if;
4078
         end;
4079
      end if;
4080
 
4081
      if Project.Extends /= No_Project then
4082
         Project.Extends.Library := False;
4083
      end if;
4084
   end Check_Library_Attributes;
4085
 
4086
   ---------------------------------
4087
   -- Check_Programming_Languages --
4088
   ---------------------------------
4089
 
4090
   procedure Check_Programming_Languages
4091
     (Project : Project_Id;
4092
      Data    : in out Tree_Processing_Data)
4093
   is
4094
      Languages   : Variable_Value := Nil_Variable_Value;
4095
      Def_Lang    : Variable_Value := Nil_Variable_Value;
4096
      Def_Lang_Id : Name_Id;
4097
 
4098
      procedure Add_Language (Name, Display_Name : Name_Id);
4099
      --  Add a new language to the list of languages for the project.
4100
      --  Nothing is done if the language has already been defined
4101
 
4102
      ------------------
4103
      -- Add_Language --
4104
      ------------------
4105
 
4106
      procedure Add_Language (Name, Display_Name : Name_Id) is
4107
         Lang : Language_Ptr;
4108
 
4109
      begin
4110
         Lang := Project.Languages;
4111
         while Lang /= No_Language_Index loop
4112
            if Name = Lang.Name then
4113
               return;
4114
            end if;
4115
 
4116
            Lang := Lang.Next;
4117
         end loop;
4118
 
4119
         Lang              := new Language_Data'(No_Language_Data);
4120
         Lang.Next         := Project.Languages;
4121
         Project.Languages := Lang;
4122
         Lang.Name         := Name;
4123
         Lang.Display_Name := Display_Name;
4124
 
4125
         if Name = Name_Ada then
4126
            Lang.Config.Kind            := Unit_Based;
4127
            Lang.Config.Dependency_Kind := ALI_File;
4128
         else
4129
            Lang.Config.Kind := File_Based;
4130
         end if;
4131
      end Add_Language;
4132
 
4133
   --  Start of processing for Check_Programming_Languages
4134
 
4135
   begin
4136
      Project.Languages := null;
4137
      Languages :=
4138
        Prj.Util.Value_Of (Name_Languages, Project.Decl.Attributes, Data.Tree);
4139
      Def_Lang :=
4140
        Prj.Util.Value_Of
4141
          (Name_Default_Language, Project.Decl.Attributes, Data.Tree);
4142
 
4143
      if Project.Source_Dirs /= Nil_String then
4144
 
4145
         --  Check if languages are specified in this project
4146
 
4147
         if Languages.Default then
4148
 
4149
            --  Fail if there is no default language defined
4150
 
4151
            if Def_Lang.Default then
4152
               Error_Msg
4153
                 (Data.Flags,
4154
                  "no languages defined for this project",
4155
                  Project.Location, Project);
4156
               Def_Lang_Id := No_Name;
4157
 
4158
            else
4159
               Get_Name_String (Def_Lang.Value);
4160
               To_Lower (Name_Buffer (1 .. Name_Len));
4161
               Def_Lang_Id := Name_Find;
4162
            end if;
4163
 
4164
            if Def_Lang_Id /= No_Name then
4165
               Get_Name_String (Def_Lang_Id);
4166
               Name_Buffer (1) := GNAT.Case_Util.To_Upper (Name_Buffer (1));
4167
               Add_Language
4168
                 (Name         => Def_Lang_Id,
4169
                  Display_Name => Name_Find);
4170
            end if;
4171
 
4172
         else
4173
            declare
4174
               Current : String_List_Id := Languages.Values;
4175
               Element : String_Element;
4176
 
4177
            begin
4178
               --  If there are no languages declared, there are no sources
4179
 
4180
               if Current = Nil_String then
4181
                  Project.Source_Dirs := Nil_String;
4182
 
4183
                  if Project.Qualifier = Standard then
4184
                     Error_Msg
4185
                       (Data.Flags,
4186
                        "a standard project must have at least one language",
4187
                        Languages.Location, Project);
4188
                  end if;
4189
 
4190
               else
4191
                  --  Look through all the languages specified in attribute
4192
                  --  Languages.
4193
 
4194
                  while Current /= Nil_String loop
4195
                     Element := Data.Tree.String_Elements.Table (Current);
4196
                     Get_Name_String (Element.Value);
4197
                     To_Lower (Name_Buffer (1 .. Name_Len));
4198
 
4199
                     Add_Language
4200
                       (Name         => Name_Find,
4201
                        Display_Name => Element.Value);
4202
 
4203
                     Current := Element.Next;
4204
                  end loop;
4205
               end if;
4206
            end;
4207
         end if;
4208
      end if;
4209
   end Check_Programming_Languages;
4210
 
4211
   -------------------------------
4212
   -- Check_Stand_Alone_Library --
4213
   -------------------------------
4214
 
4215
   procedure Check_Stand_Alone_Library
4216
     (Project : Project_Id;
4217
      Data    : in out Tree_Processing_Data)
4218
   is
4219
      Lib_Interfaces      : constant Prj.Variable_Value :=
4220
                              Prj.Util.Value_Of
4221
                                (Snames.Name_Library_Interface,
4222
                                 Project.Decl.Attributes,
4223
                                 Data.Tree);
4224
 
4225
      Lib_Auto_Init       : constant Prj.Variable_Value :=
4226
                              Prj.Util.Value_Of
4227
                                (Snames.Name_Library_Auto_Init,
4228
                                 Project.Decl.Attributes,
4229
                                 Data.Tree);
4230
 
4231
      Lib_Src_Dir         : constant Prj.Variable_Value :=
4232
                              Prj.Util.Value_Of
4233
                                (Snames.Name_Library_Src_Dir,
4234
                                 Project.Decl.Attributes,
4235
                                 Data.Tree);
4236
 
4237
      Lib_Symbol_File     : constant Prj.Variable_Value :=
4238
                              Prj.Util.Value_Of
4239
                                (Snames.Name_Library_Symbol_File,
4240
                                 Project.Decl.Attributes,
4241
                                 Data.Tree);
4242
 
4243
      Lib_Symbol_Policy   : constant Prj.Variable_Value :=
4244
                              Prj.Util.Value_Of
4245
                                (Snames.Name_Library_Symbol_Policy,
4246
                                 Project.Decl.Attributes,
4247
                                 Data.Tree);
4248
 
4249
      Lib_Ref_Symbol_File : constant Prj.Variable_Value :=
4250
                              Prj.Util.Value_Of
4251
                                (Snames.Name_Library_Reference_Symbol_File,
4252
                                 Project.Decl.Attributes,
4253
                                 Data.Tree);
4254
 
4255
      Auto_Init_Supported : Boolean;
4256
      OK                  : Boolean := True;
4257
      Source              : Source_Id;
4258
      Next_Proj           : Project_Id;
4259
      Iter                : Source_Iterator;
4260
 
4261
   begin
4262
      Auto_Init_Supported := Project.Config.Auto_Init_Supported;
4263
 
4264
      pragma Assert (Lib_Interfaces.Kind = List);
4265
 
4266
      --  It is a stand-alone library project file if attribute
4267
      --  Library_Interface is defined.
4268
 
4269
      if not Lib_Interfaces.Default then
4270
         declare
4271
            Interfaces     : String_List_Id := Lib_Interfaces.Values;
4272
            Interface_ALIs : String_List_Id := Nil_String;
4273
            Unit           : Name_Id;
4274
 
4275
         begin
4276
            Project.Standalone_Library := True;
4277
 
4278
            --  Library_Interface cannot be an empty list
4279
 
4280
            if Interfaces = Nil_String then
4281
               Error_Msg
4282
                 (Data.Flags,
4283
                  "Library_Interface cannot be an empty list",
4284
                  Lib_Interfaces.Location, Project);
4285
            end if;
4286
 
4287
            --  Process each unit name specified in the attribute
4288
            --  Library_Interface.
4289
 
4290
            while Interfaces /= Nil_String loop
4291
               Get_Name_String
4292
                 (Data.Tree.String_Elements.Table (Interfaces).Value);
4293
               To_Lower (Name_Buffer (1 .. Name_Len));
4294
 
4295
               if Name_Len = 0 then
4296
                  Error_Msg
4297
                    (Data.Flags,
4298
                     "an interface cannot be an empty string",
4299
                     Data.Tree.String_Elements.Table (Interfaces).Location,
4300
                     Project);
4301
 
4302
               else
4303
                  Unit := Name_Find;
4304
                  Error_Msg_Name_1 := Unit;
4305
 
4306
                  Next_Proj := Project.Extends;
4307
                  Iter := For_Each_Source (Data.Tree, Project);
4308
                  loop
4309
                     while Prj.Element (Iter) /= No_Source
4310
                       and then
4311
                         (Prj.Element (Iter).Unit = null
4312
                           or else Prj.Element (Iter).Unit.Name /= Unit)
4313
                     loop
4314
                        Next (Iter);
4315
                     end loop;
4316
 
4317
                     Source := Prj.Element (Iter);
4318
                     exit when Source /= No_Source
4319
                       or else Next_Proj = No_Project;
4320
 
4321
                     Iter := For_Each_Source (Data.Tree, Next_Proj);
4322
                     Next_Proj := Next_Proj.Extends;
4323
                  end loop;
4324
 
4325
                  if Source /= No_Source then
4326
                     if Source.Kind = Sep then
4327
                        Source := No_Source;
4328
 
4329
                     elsif Source.Kind = Spec
4330
                       and then Other_Part (Source) /= No_Source
4331
                     then
4332
                        Source := Other_Part (Source);
4333
                     end if;
4334
                  end if;
4335
 
4336
                  if Source /= No_Source then
4337
                     if Source.Project /= Project
4338
                       and then not Is_Extending (Project, Source.Project)
4339
                     then
4340
                        Source := No_Source;
4341
                     end if;
4342
                  end if;
4343
 
4344
                  if Source = No_Source then
4345
                     Error_Msg
4346
                       (Data.Flags,
4347
                        "%% is not a unit of this project",
4348
                        Data.Tree.String_Elements.Table
4349
                          (Interfaces).Location, Project);
4350
 
4351
                  else
4352
                     if Source.Kind = Spec
4353
                       and then Other_Part (Source) /= No_Source
4354
                     then
4355
                        Source := Other_Part (Source);
4356
                     end if;
4357
 
4358
                     String_Element_Table.Increment_Last
4359
                       (Data.Tree.String_Elements);
4360
 
4361
                     Data.Tree.String_Elements.Table
4362
                       (String_Element_Table.Last
4363
                          (Data.Tree.String_Elements)) :=
4364
                       (Value         => Name_Id (Source.Dep_Name),
4365
                        Index         => 0,
4366
                        Display_Value => Name_Id (Source.Dep_Name),
4367
                        Location      =>
4368
                          Data.Tree.String_Elements.Table
4369
                            (Interfaces).Location,
4370
                        Flag          => False,
4371
                        Next          => Interface_ALIs);
4372
 
4373
                     Interface_ALIs :=
4374
                       String_Element_Table.Last
4375
                         (Data.Tree.String_Elements);
4376
                  end if;
4377
               end if;
4378
 
4379
               Interfaces := Data.Tree.String_Elements.Table (Interfaces).Next;
4380
            end loop;
4381
 
4382
            --  Put the list of Interface ALIs in the project data
4383
 
4384
            Project.Lib_Interface_ALIs := Interface_ALIs;
4385
 
4386
            --  Check value of attribute Library_Auto_Init and set
4387
            --  Lib_Auto_Init accordingly.
4388
 
4389
            if Lib_Auto_Init.Default then
4390
 
4391
               --  If no attribute Library_Auto_Init is declared, then set auto
4392
               --  init only if it is supported.
4393
 
4394
               Project.Lib_Auto_Init := Auto_Init_Supported;
4395
 
4396
            else
4397
               Get_Name_String (Lib_Auto_Init.Value);
4398
               To_Lower (Name_Buffer (1 .. Name_Len));
4399
 
4400
               if Name_Buffer (1 .. Name_Len) = "false" then
4401
                  Project.Lib_Auto_Init := False;
4402
 
4403
               elsif Name_Buffer (1 .. Name_Len) = "true" then
4404
                  if Auto_Init_Supported then
4405
                     Project.Lib_Auto_Init := True;
4406
 
4407
                  else
4408
                     --  Library_Auto_Init cannot be "true" if auto init is not
4409
                     --  supported.
4410
 
4411
                     Error_Msg
4412
                       (Data.Flags,
4413
                        "library auto init not supported " &
4414
                        "on this platform",
4415
                        Lib_Auto_Init.Location, Project);
4416
                  end if;
4417
 
4418
               else
4419
                  Error_Msg
4420
                    (Data.Flags,
4421
                     "invalid value for attribute Library_Auto_Init",
4422
                     Lib_Auto_Init.Location, Project);
4423
               end if;
4424
            end if;
4425
         end;
4426
 
4427
         --  If attribute Library_Src_Dir is defined and not the empty string,
4428
         --  check if the directory exist and is not the object directory or
4429
         --  one of the source directories. This is the directory where copies
4430
         --  of the interface sources will be copied. Note that this directory
4431
         --  may be the library directory.
4432
 
4433
         if Lib_Src_Dir.Value /= Empty_String then
4434
            declare
4435
               Dir_Id     : constant File_Name_Type :=
4436
                              File_Name_Type (Lib_Src_Dir.Value);
4437
               Dir_Exists : Boolean;
4438
 
4439
            begin
4440
               Locate_Directory
4441
                 (Project,
4442
                  Dir_Id,
4443
                  Path             => Project.Library_Src_Dir,
4444
                  Dir_Exists       => Dir_Exists,
4445
                  Data             => Data,
4446
                  Must_Exist       => False,
4447
                  Create           => "library source copy",
4448
                  Location         => Lib_Src_Dir.Location,
4449
                  Externally_Built => Project.Externally_Built);
4450
 
4451
               --  If directory does not exist, report an error
4452
 
4453
               if not Dir_Exists then
4454
 
4455
                  --  Get the absolute name of the library directory that does
4456
                  --  not exist, to report an error.
4457
 
4458
                  Err_Vars.Error_Msg_File_1 :=
4459
                    File_Name_Type (Project.Library_Src_Dir.Display_Name);
4460
                  Error_Msg
4461
                    (Data.Flags,
4462
                     "Directory { does not exist",
4463
                     Lib_Src_Dir.Location, Project);
4464
 
4465
                  --  Report error if it is the same as the object directory
4466
 
4467
               elsif Project.Library_Src_Dir = Project.Object_Directory then
4468
                  Error_Msg
4469
                    (Data.Flags,
4470
                     "directory to copy interfaces cannot be " &
4471
                     "the object directory",
4472
                     Lib_Src_Dir.Location, Project);
4473
                  Project.Library_Src_Dir := No_Path_Information;
4474
 
4475
               else
4476
                  declare
4477
                     Src_Dirs : String_List_Id;
4478
                     Src_Dir  : String_Element;
4479
                     Pid      : Project_List;
4480
 
4481
                  begin
4482
                     --  Interface copy directory cannot be one of the source
4483
                     --  directory of the current project.
4484
 
4485
                     Src_Dirs := Project.Source_Dirs;
4486
                     while Src_Dirs /= Nil_String loop
4487
                        Src_Dir := Data.Tree.String_Elements.Table (Src_Dirs);
4488
 
4489
                        --  Report error if it is one of the source directories
4490
 
4491
                        if Project.Library_Src_Dir.Name =
4492
                             Path_Name_Type (Src_Dir.Value)
4493
                        then
4494
                           Error_Msg
4495
                             (Data.Flags,
4496
                              "directory to copy interfaces cannot " &
4497
                              "be one of the source directories",
4498
                              Lib_Src_Dir.Location, Project);
4499
                           Project.Library_Src_Dir := No_Path_Information;
4500
                           exit;
4501
                        end if;
4502
 
4503
                        Src_Dirs := Src_Dir.Next;
4504
                     end loop;
4505
 
4506
                     if Project.Library_Src_Dir /= No_Path_Information then
4507
 
4508
                        --  It cannot be a source directory of any other
4509
                        --  project either.
4510
 
4511
                        Pid := Data.Tree.Projects;
4512
                        Project_Loop : loop
4513
                           exit Project_Loop when Pid = null;
4514
 
4515
                           Src_Dirs := Pid.Project.Source_Dirs;
4516
                           Dir_Loop : while Src_Dirs /= Nil_String loop
4517
                              Src_Dir :=
4518
                                Data.Tree.String_Elements.Table (Src_Dirs);
4519
 
4520
                              --  Report error if it is one of the source
4521
                              --  directories.
4522
 
4523
                              if Project.Library_Src_Dir.Name =
4524
                                Path_Name_Type (Src_Dir.Value)
4525
                              then
4526
                                 Error_Msg_File_1 :=
4527
                                   File_Name_Type (Src_Dir.Value);
4528
                                 Error_Msg_Name_1 := Pid.Project.Name;
4529
                                 Error_Msg
4530
                                   (Data.Flags,
4531
                                    "directory to copy interfaces cannot " &
4532
                                    "be the same as source directory { of " &
4533
                                    "project %%",
4534
                                    Lib_Src_Dir.Location, Project);
4535
                                 Project.Library_Src_Dir :=
4536
                                   No_Path_Information;
4537
                                 exit Project_Loop;
4538
                              end if;
4539
 
4540
                              Src_Dirs := Src_Dir.Next;
4541
                           end loop Dir_Loop;
4542
 
4543
                           Pid := Pid.Next;
4544
                        end loop Project_Loop;
4545
                     end if;
4546
                  end;
4547
 
4548
                  --  In high verbosity, if there is a valid Library_Src_Dir,
4549
                  --  display its path name.
4550
 
4551
                  if Project.Library_Src_Dir /= No_Path_Information
4552
                    and then Current_Verbosity = High
4553
                  then
4554
                     Write_Attr
4555
                       ("Directory to copy interfaces",
4556
                        Get_Name_String (Project.Library_Src_Dir.Name));
4557
                  end if;
4558
               end if;
4559
            end;
4560
         end if;
4561
 
4562
         --  Check the symbol related attributes
4563
 
4564
         --  First, the symbol policy
4565
 
4566
         if not Lib_Symbol_Policy.Default then
4567
            declare
4568
               Value : constant String :=
4569
                         To_Lower
4570
                           (Get_Name_String (Lib_Symbol_Policy.Value));
4571
 
4572
            begin
4573
               --  Symbol policy must hove one of a limited number of values
4574
 
4575
               if Value = "autonomous" or else Value = "default" then
4576
                  Project.Symbol_Data.Symbol_Policy := Autonomous;
4577
 
4578
               elsif Value = "compliant" then
4579
                  Project.Symbol_Data.Symbol_Policy := Compliant;
4580
 
4581
               elsif Value = "controlled" then
4582
                  Project.Symbol_Data.Symbol_Policy := Controlled;
4583
 
4584
               elsif Value = "restricted" then
4585
                  Project.Symbol_Data.Symbol_Policy := Restricted;
4586
 
4587
               elsif Value = "direct" then
4588
                  Project.Symbol_Data.Symbol_Policy := Direct;
4589
 
4590
               else
4591
                  Error_Msg
4592
                    (Data.Flags,
4593
                     "illegal value for Library_Symbol_Policy",
4594
                     Lib_Symbol_Policy.Location, Project);
4595
               end if;
4596
            end;
4597
         end if;
4598
 
4599
         --  If attribute Library_Symbol_File is not specified, symbol policy
4600
         --  cannot be Restricted.
4601
 
4602
         if Lib_Symbol_File.Default then
4603
            if Project.Symbol_Data.Symbol_Policy = Restricted then
4604
               Error_Msg
4605
                 (Data.Flags,
4606
                  "Library_Symbol_File needs to be defined when " &
4607
                  "symbol policy is Restricted",
4608
                  Lib_Symbol_Policy.Location, Project);
4609
            end if;
4610
 
4611
         else
4612
            --  Library_Symbol_File is defined
4613
 
4614
            Project.Symbol_Data.Symbol_File :=
4615
              Path_Name_Type (Lib_Symbol_File.Value);
4616
 
4617
            Get_Name_String (Lib_Symbol_File.Value);
4618
 
4619
            if Name_Len = 0 then
4620
               Error_Msg
4621
                 (Data.Flags,
4622
                  "symbol file name cannot be an empty string",
4623
                  Lib_Symbol_File.Location, Project);
4624
 
4625
            else
4626
               OK := not Is_Absolute_Path (Name_Buffer (1 .. Name_Len));
4627
 
4628
               if OK then
4629
                  for J in 1 .. Name_Len loop
4630
                     if Name_Buffer (J) = '/'
4631
                       or else Name_Buffer (J) = Directory_Separator
4632
                     then
4633
                        OK := False;
4634
                        exit;
4635
                     end if;
4636
                  end loop;
4637
               end if;
4638
 
4639
               if not OK then
4640
                  Error_Msg_File_1 := File_Name_Type (Lib_Symbol_File.Value);
4641
                  Error_Msg
4642
                    (Data.Flags,
4643
                     "symbol file name { is illegal. " &
4644
                     "Name cannot include directory info.",
4645
                     Lib_Symbol_File.Location, Project);
4646
               end if;
4647
            end if;
4648
         end if;
4649
 
4650
         --  If attribute Library_Reference_Symbol_File is not defined,
4651
         --  symbol policy cannot be Compliant or Controlled.
4652
 
4653
         if Lib_Ref_Symbol_File.Default then
4654
            if Project.Symbol_Data.Symbol_Policy = Compliant
4655
              or else Project.Symbol_Data.Symbol_Policy = Controlled
4656
            then
4657
               Error_Msg
4658
                 (Data.Flags,
4659
                  "a reference symbol file needs to be defined",
4660
                  Lib_Symbol_Policy.Location, Project);
4661
            end if;
4662
 
4663
         else
4664
            --  Library_Reference_Symbol_File is defined, check file exists
4665
 
4666
            Project.Symbol_Data.Reference :=
4667
              Path_Name_Type (Lib_Ref_Symbol_File.Value);
4668
 
4669
            Get_Name_String (Lib_Ref_Symbol_File.Value);
4670
 
4671
            if Name_Len = 0 then
4672
               Error_Msg
4673
                 (Data.Flags,
4674
                  "reference symbol file name cannot be an empty string",
4675
                  Lib_Symbol_File.Location, Project);
4676
 
4677
            else
4678
               if not Is_Absolute_Path (Name_Buffer (1 .. Name_Len)) then
4679
                  Name_Len := 0;
4680
                  Add_Str_To_Name_Buffer
4681
                    (Get_Name_String (Project.Directory.Name));
4682
                  Add_Str_To_Name_Buffer
4683
                    (Get_Name_String (Lib_Ref_Symbol_File.Value));
4684
                  Project.Symbol_Data.Reference := Name_Find;
4685
               end if;
4686
 
4687
               if not Is_Regular_File
4688
                        (Get_Name_String (Project.Symbol_Data.Reference))
4689
               then
4690
                  Error_Msg_File_1 :=
4691
                    File_Name_Type (Lib_Ref_Symbol_File.Value);
4692
 
4693
                  --  For controlled and direct symbol policies, it is an error
4694
                  --  if the reference symbol file does not exist. For other
4695
                  --  symbol policies, this is just a warning
4696
 
4697
                  Error_Msg_Warn :=
4698
                    Project.Symbol_Data.Symbol_Policy /= Controlled
4699
                    and then Project.Symbol_Data.Symbol_Policy /= Direct;
4700
 
4701
                  Error_Msg
4702
                    (Data.Flags,
4703
                     "<library reference symbol file { does not exist",
4704
                     Lib_Ref_Symbol_File.Location, Project);
4705
 
4706
                  --  In addition in the non-controlled case, if symbol policy
4707
                  --  is Compliant, it is changed to Autonomous, because there
4708
                  --  is no reference to check against, and we don't want to
4709
                  --  fail in this case.
4710
 
4711
                  if Project.Symbol_Data.Symbol_Policy /= Controlled then
4712
                     if Project.Symbol_Data.Symbol_Policy = Compliant then
4713
                        Project.Symbol_Data.Symbol_Policy := Autonomous;
4714
                     end if;
4715
                  end if;
4716
               end if;
4717
 
4718
               --  If both the reference symbol file and the symbol file are
4719
               --  defined, then check that they are not the same file.
4720
 
4721
               if Project.Symbol_Data.Symbol_File /= No_Path then
4722
                  Get_Name_String (Project.Symbol_Data.Symbol_File);
4723
 
4724
                  if Name_Len > 0 then
4725
                     declare
4726
                        --  We do not need to pass a Directory to
4727
                        --  Normalize_Pathname, since the path_information
4728
                        --  already contains absolute information.
4729
 
4730
                        Symb_Path : constant String :=
4731
                                      Normalize_Pathname
4732
                                        (Get_Name_String
4733
                                           (Project.Object_Directory.Name) &
4734
                                         Name_Buffer (1 .. Name_Len),
4735
                                         Directory     => "/",
4736
                                         Resolve_Links =>
4737
                                           Opt.Follow_Links_For_Files);
4738
                        Ref_Path  : constant String :=
4739
                                      Normalize_Pathname
4740
                                        (Get_Name_String
4741
                                           (Project.Symbol_Data.Reference),
4742
                                         Directory     => "/",
4743
                                         Resolve_Links =>
4744
                                           Opt.Follow_Links_For_Files);
4745
                     begin
4746
                        if Symb_Path = Ref_Path then
4747
                           Error_Msg
4748
                             (Data.Flags,
4749
                              "library reference symbol file and library" &
4750
                              " symbol file cannot be the same file",
4751
                              Lib_Ref_Symbol_File.Location, Project);
4752
                        end if;
4753
                     end;
4754
                  end if;
4755
               end if;
4756
            end if;
4757
         end if;
4758
      end if;
4759
   end Check_Stand_Alone_Library;
4760
 
4761
   ----------------------------
4762
   -- Compute_Directory_Last --
4763
   ----------------------------
4764
 
4765
   function Compute_Directory_Last (Dir : String) return Natural is
4766
   begin
4767
      if Dir'Length > 1
4768
        and then (Dir (Dir'Last - 1) = Directory_Separator
4769
                    or else
4770
                  Dir (Dir'Last - 1) = '/')
4771
      then
4772
         return Dir'Last - 1;
4773
      else
4774
         return Dir'Last;
4775
      end if;
4776
   end Compute_Directory_Last;
4777
 
4778
   ---------------------
4779
   -- Get_Directories --
4780
   ---------------------
4781
 
4782
   procedure Get_Directories
4783
     (Project     : Project_Id;
4784
      Data        : in out Tree_Processing_Data)
4785
   is
4786
      package Recursive_Dirs is new GNAT.Dynamic_HTables.Simple_HTable
4787
        (Header_Num => Header_Num,
4788
         Element    => Boolean,
4789
         No_Element => False,
4790
         Key        => Name_Id,
4791
         Hash       => Hash,
4792
         Equal      => "=");
4793
      --  Hash table stores recursive source directories, to avoid looking
4794
      --  several times, and to avoid cycles that may be introduced by symbolic
4795
      --  links.
4796
 
4797
      Visited : Recursive_Dirs.Instance;
4798
 
4799
      Object_Dir  : constant Variable_Value :=
4800
                      Util.Value_Of
4801
                        (Name_Object_Dir, Project.Decl.Attributes, Data.Tree);
4802
 
4803
      Exec_Dir : constant Variable_Value :=
4804
                   Util.Value_Of
4805
                     (Name_Exec_Dir, Project.Decl.Attributes, Data.Tree);
4806
 
4807
      Source_Dirs : constant Variable_Value :=
4808
                      Util.Value_Of
4809
                        (Name_Source_Dirs, Project.Decl.Attributes, Data.Tree);
4810
 
4811
      Excluded_Source_Dirs : constant Variable_Value :=
4812
                              Util.Value_Of
4813
                                (Name_Excluded_Source_Dirs,
4814
                                 Project.Decl.Attributes,
4815
                                 Data.Tree);
4816
 
4817
      Source_Files : constant Variable_Value :=
4818
                      Util.Value_Of
4819
                        (Name_Source_Files,
4820
                         Project.Decl.Attributes, Data.Tree);
4821
 
4822
      Last_Source_Dir   : String_List_Id    := Nil_String;
4823
      Last_Src_Dir_Rank : Number_List_Index := No_Number_List;
4824
 
4825
      Languages : constant Variable_Value :=
4826
                      Prj.Util.Value_Of
4827
                        (Name_Languages, Project.Decl.Attributes, Data.Tree);
4828
 
4829
      procedure Find_Source_Dirs
4830
        (From     : File_Name_Type;
4831
         Location : Source_Ptr;
4832
         Rank     : Natural;
4833
         Removed  : Boolean := False);
4834
      --  Find one or several source directories, and add (or remove, if
4835
      --  Removed is True) them to list of source directories of the project.
4836
 
4837
      ----------------------
4838
      -- Find_Source_Dirs --
4839
      ----------------------
4840
 
4841
      procedure Find_Source_Dirs
4842
        (From     : File_Name_Type;
4843
         Location : Source_Ptr;
4844
         Rank     : Natural;
4845
         Removed  : Boolean := False)
4846
      is
4847
         Directory : constant String := Get_Name_String (From);
4848
 
4849
         procedure Add_To_Or_Remove_From_List
4850
           (Path_Id         : Name_Id;
4851
            Display_Path_Id : Name_Id);
4852
         --  When Removed = False, the directory Path_Id to the list of
4853
         --  source_dirs if not already in the list. When Removed = True,
4854
         --  removed directory Path_Id if in the list.
4855
 
4856
         procedure Recursive_Find_Dirs (Path : Name_Id);
4857
         --  Find all the subdirectories (recursively) of Path and add them
4858
         --  to the list of source directories of the project.
4859
 
4860
         --------------------------------
4861
         -- Add_To_Or_Remove_From_List --
4862
         --------------------------------
4863
 
4864
         procedure Add_To_Or_Remove_From_List
4865
           (Path_Id         : Name_Id;
4866
            Display_Path_Id : Name_Id)
4867
         is
4868
            List       : String_List_Id;
4869
            Prev       : String_List_Id;
4870
            Rank_List  : Number_List_Index;
4871
            Prev_Rank  : Number_List_Index;
4872
            Element    : String_Element;
4873
 
4874
         begin
4875
            Prev      := Nil_String;
4876
            Prev_Rank := No_Number_List;
4877
            List      := Project.Source_Dirs;
4878
            Rank_List := Project.Source_Dir_Ranks;
4879
            while List /= Nil_String loop
4880
               Element := Data.Tree.String_Elements.Table (List);
4881
               exit when Element.Value = Path_Id;
4882
               Prev := List;
4883
               List := Element.Next;
4884
               Prev_Rank := Rank_List;
4885
               Rank_List := Data.Tree.Number_Lists.Table (Prev_Rank).Next;
4886
            end loop;
4887
 
4888
            --  The directory is in the list if List is not Nil_String
4889
 
4890
            if not Removed and then List = Nil_String then
4891
               if Current_Verbosity = High then
4892
                  Write_Str  ("   Adding Source Dir=");
4893
                  Write_Line (Get_Name_String (Path_Id));
4894
               end if;
4895
 
4896
               String_Element_Table.Increment_Last (Data.Tree.String_Elements);
4897
               Element :=
4898
                 (Value         => Path_Id,
4899
                  Index         => 0,
4900
                  Display_Value => Display_Path_Id,
4901
                  Location      => No_Location,
4902
                  Flag          => False,
4903
                  Next          => Nil_String);
4904
 
4905
               Number_List_Table.Increment_Last (Data.Tree.Number_Lists);
4906
 
4907
               if Last_Source_Dir = Nil_String then
4908
 
4909
                  --  This is the first source directory
4910
 
4911
                  Project.Source_Dirs :=
4912
                    String_Element_Table.Last (Data.Tree.String_Elements);
4913
                  Project.Source_Dir_Ranks :=
4914
                    Number_List_Table.Last (Data.Tree.Number_Lists);
4915
 
4916
               else
4917
                  --  We already have source directories, link the previous
4918
                  --  last to the new one.
4919
 
4920
                  Data.Tree.String_Elements.Table (Last_Source_Dir).Next :=
4921
                    String_Element_Table.Last (Data.Tree.String_Elements);
4922
                  Data.Tree.Number_Lists.Table (Last_Src_Dir_Rank).Next :=
4923
                    Number_List_Table.Last (Data.Tree.Number_Lists);
4924
               end if;
4925
 
4926
               --  And register this source directory as the new last
4927
 
4928
               Last_Source_Dir :=
4929
                 String_Element_Table.Last (Data.Tree.String_Elements);
4930
               Data.Tree.String_Elements.Table (Last_Source_Dir) := Element;
4931
               Last_Src_Dir_Rank :=
4932
                 Number_List_Table.Last (Data.Tree.Number_Lists);
4933
               Data.Tree.Number_Lists.Table (Last_Src_Dir_Rank) :=
4934
                 (Number => Rank, Next => No_Number_List);
4935
 
4936
            elsif Removed and then List /= Nil_String then
4937
 
4938
               --  Remove source dir, if present
4939
 
4940
               if Prev = Nil_String then
4941
                  Project.Source_Dirs :=
4942
                    Data.Tree.String_Elements.Table (List).Next;
4943
                  Project.Source_Dir_Ranks :=
4944
                    Data.Tree.Number_Lists.Table (Rank_List).Next;
4945
 
4946
               else
4947
                  Data.Tree.String_Elements.Table (Prev).Next :=
4948
                    Data.Tree.String_Elements.Table (List).Next;
4949
                  Data.Tree.Number_Lists.Table (Prev_Rank).Next :=
4950
                    Data.Tree.Number_Lists.Table (Rank_List).Next;
4951
               end if;
4952
            end if;
4953
         end Add_To_Or_Remove_From_List;
4954
 
4955
         -------------------------
4956
         -- Recursive_Find_Dirs --
4957
         -------------------------
4958
 
4959
         procedure Recursive_Find_Dirs (Path : Name_Id) is
4960
            Dir  : Dir_Type;
4961
            Name : String (1 .. 250);
4962
            Last : Natural;
4963
 
4964
            Non_Canonical_Path : Name_Id := No_Name;
4965
            Canonical_Path     : Name_Id := No_Name;
4966
 
4967
            The_Path : constant String :=
4968
                         Normalize_Pathname
4969
                           (Get_Name_String (Path),
4970
                            Directory     =>
4971
                              Get_Name_String (Project.Directory.Display_Name),
4972
                            Resolve_Links => Opt.Follow_Links_For_Dirs) &
4973
                         Directory_Separator;
4974
 
4975
            The_Path_Last : constant Natural :=
4976
                              Compute_Directory_Last (The_Path);
4977
 
4978
         begin
4979
            Name_Len := The_Path_Last - The_Path'First + 1;
4980
            Name_Buffer (1 .. Name_Len) :=
4981
              The_Path (The_Path'First .. The_Path_Last);
4982
            Non_Canonical_Path := Name_Find;
4983
            Canonical_Path :=
4984
              Name_Id (Canonical_Case_File_Name (Non_Canonical_Path));
4985
 
4986
            --  To avoid processing the same directory several times, check
4987
            --  if the directory is already in Recursive_Dirs. If it is, then
4988
            --  there is nothing to do, just return. If it is not, put it there
4989
            --  and continue recursive processing.
4990
 
4991
            if not Removed then
4992
               if Recursive_Dirs.Get (Visited, Canonical_Path) then
4993
                  return;
4994
               else
4995
                  Recursive_Dirs.Set (Visited, Canonical_Path, True);
4996
               end if;
4997
            end if;
4998
 
4999
            Add_To_Or_Remove_From_List
5000
              (Path_Id         => Canonical_Path,
5001
               Display_Path_Id => Non_Canonical_Path);
5002
 
5003
            --  Now look for subdirectories. Do that even when this directory
5004
            --  is already in the list, because some of its subdirectories may
5005
            --  not be in the list yet.
5006
 
5007
            Open (Dir, The_Path (The_Path'First .. The_Path_Last));
5008
 
5009
            loop
5010
               Read (Dir, Name, Last);
5011
               exit when Last = 0;
5012
 
5013
               if Name (1 .. Last) /= "."
5014
                 and then Name (1 .. Last) /= ".."
5015
               then
5016
                  --  Avoid . and .. directories
5017
 
5018
                  if Current_Verbosity = High then
5019
                     Write_Str  ("   Checking ");
5020
                     Write_Line (Name (1 .. Last));
5021
                  end if;
5022
 
5023
                  declare
5024
                     Path_Name : constant String :=
5025
                                   Normalize_Pathname
5026
                                     (Name           => Name (1 .. Last),
5027
                                      Directory      =>
5028
                                        The_Path
5029
                                          (The_Path'First .. The_Path_Last),
5030
                                      Resolve_Links  =>
5031
                                        Opt.Follow_Links_For_Dirs,
5032
                                      Case_Sensitive => True);
5033
 
5034
                  begin
5035
                     if Is_Directory (Path_Name) then
5036
 
5037
                        --  We have found a new subdirectory, call self
5038
 
5039
                        Name_Len := Path_Name'Length;
5040
                        Name_Buffer (1 .. Name_Len) := Path_Name;
5041
                        Recursive_Find_Dirs (Name_Find);
5042
                     end if;
5043
                  end;
5044
               end if;
5045
            end loop;
5046
 
5047
            Close (Dir);
5048
 
5049
         exception
5050
            when Directory_Error =>
5051
               null;
5052
         end Recursive_Find_Dirs;
5053
 
5054
      --  Start of processing for Find_Source_Dirs
5055
 
5056
      begin
5057
         if Current_Verbosity = High and then not Removed then
5058
            Write_Str ("Find_Source_Dirs (""");
5059
            Write_Str (Directory);
5060
            Write_Str (",");
5061
            Write_Str (Rank'Img);
5062
            Write_Line (""")");
5063
         end if;
5064
 
5065
         --  First, check if we are looking for a directory tree, indicated
5066
         --  by "/**" at the end.
5067
 
5068
         if Directory'Length >= 3
5069
           and then Directory (Directory'Last - 1 .. Directory'Last) = "**"
5070
           and then (Directory (Directory'Last - 2) = '/'
5071
                       or else
5072
                     Directory (Directory'Last - 2) = Directory_Separator)
5073
         then
5074
            Name_Len := Directory'Length - 3;
5075
 
5076
            if Name_Len = 0 then
5077
 
5078
               --  Case of "/**": all directories in file system
5079
 
5080
               Name_Len := 1;
5081
               Name_Buffer (1) := Directory (Directory'First);
5082
 
5083
            else
5084
               Name_Buffer (1 .. Name_Len) :=
5085
                 Directory (Directory'First .. Directory'Last - 3);
5086
            end if;
5087
 
5088
            if Current_Verbosity = High then
5089
               Write_Str ("Looking for all subdirectories of """);
5090
               Write_Str (Name_Buffer (1 .. Name_Len));
5091
               Write_Line ("""");
5092
            end if;
5093
 
5094
            declare
5095
               Base_Dir : constant File_Name_Type := Name_Find;
5096
               Root_Dir : constant String :=
5097
                            Normalize_Pathname
5098
                              (Name      => Get_Name_String (Base_Dir),
5099
                               Directory =>
5100
                                 Get_Name_String
5101
                                   (Project.Directory.Display_Name),
5102
                               Resolve_Links  =>
5103
                                 Opt.Follow_Links_For_Dirs,
5104
                               Case_Sensitive => True);
5105
 
5106
            begin
5107
               if Root_Dir'Length = 0 then
5108
                  Err_Vars.Error_Msg_File_1 := Base_Dir;
5109
 
5110
                  if Location = No_Location then
5111
                     Error_Msg
5112
                       (Data.Flags,
5113
                        "{ is not a valid directory.",
5114
                        Project.Location, Project);
5115
                  else
5116
                     Error_Msg
5117
                       (Data.Flags,
5118
                        "{ is not a valid directory.",
5119
                        Location, Project);
5120
                  end if;
5121
 
5122
               else
5123
                  --  We have an existing directory, we register it and all of
5124
                  --  its subdirectories.
5125
 
5126
                  if Current_Verbosity = High then
5127
                     Write_Line ("Looking for source directories:");
5128
                  end if;
5129
 
5130
                  Name_Len := Root_Dir'Length;
5131
                  Name_Buffer (1 .. Name_Len) := Root_Dir;
5132
                  Recursive_Find_Dirs (Name_Find);
5133
 
5134
                  if Current_Verbosity = High then
5135
                     Write_Line ("End of looking for source directories.");
5136
                  end if;
5137
               end if;
5138
            end;
5139
 
5140
         --  We have a single directory
5141
 
5142
         else
5143
            declare
5144
               Path_Name  : Path_Information;
5145
               Dir_Exists : Boolean;
5146
 
5147
            begin
5148
               Locate_Directory
5149
                 (Project     => Project,
5150
                  Name        => From,
5151
                  Path        => Path_Name,
5152
                  Dir_Exists  => Dir_Exists,
5153
                  Data        => Data,
5154
                  Must_Exist  => False);
5155
 
5156
               if not Dir_Exists then
5157
                  Err_Vars.Error_Msg_File_1 := From;
5158
 
5159
                  if Location = No_Location then
5160
                     Error_Msg
5161
                       (Data.Flags,
5162
                        "{ is not a valid directory",
5163
                        Project.Location, Project);
5164
                  else
5165
                     Error_Msg
5166
                       (Data.Flags,
5167
                        "{ is not a valid directory",
5168
                        Location, Project);
5169
                  end if;
5170
 
5171
               else
5172
                  declare
5173
                     Path : constant String :=
5174
                              Normalize_Pathname
5175
                                (Name           =>
5176
                                   Get_Name_String (Path_Name.Name),
5177
                                 Directory      =>
5178
                                   Get_Name_String (Project.Directory.Name),
5179
                                 Resolve_Links  => Opt.Follow_Links_For_Dirs,
5180
                                 Case_Sensitive => True) &
5181
                              Directory_Separator;
5182
 
5183
                     Last_Path         : constant Natural :=
5184
                                           Compute_Directory_Last (Path);
5185
                     Path_Id           : Name_Id;
5186
                     Display_Path      : constant String :=
5187
                                           Get_Name_String
5188
                                             (Path_Name.Display_Name);
5189
                     Last_Display_Path : constant Natural :=
5190
                                           Compute_Directory_Last
5191
                                             (Display_Path);
5192
                     Display_Path_Id   : Name_Id;
5193
 
5194
                  begin
5195
                     Name_Len := 0;
5196
                     Add_Str_To_Name_Buffer (Path (Path'First .. Last_Path));
5197
                     Path_Id := Name_Find;
5198
 
5199
                     Name_Len := 0;
5200
                     Add_Str_To_Name_Buffer
5201
                       (Display_Path
5202
                          (Display_Path'First .. Last_Display_Path));
5203
                     Display_Path_Id := Name_Find;
5204
 
5205
                     Add_To_Or_Remove_From_List
5206
                       (Path_Id         => Path_Id,
5207
                        Display_Path_Id => Display_Path_Id);
5208
                  end;
5209
               end if;
5210
            end;
5211
         end if;
5212
 
5213
         Recursive_Dirs.Reset (Visited);
5214
      end Find_Source_Dirs;
5215
 
5216
   --  Start of processing for Get_Directories
5217
 
5218
      Dir_Exists : Boolean;
5219
 
5220
   begin
5221
      if Current_Verbosity = High then
5222
         Write_Line ("Starting to look for directories");
5223
      end if;
5224
 
5225
      --  Set the object directory to its default which may be nil, if there
5226
      --  is no sources in the project.
5227
 
5228
      if (((not Source_Files.Default)
5229
             and then Source_Files.Values = Nil_String)
5230
          or else
5231
           ((not Source_Dirs.Default) and then Source_Dirs.Values = Nil_String)
5232
              or else
5233
           ((not Languages.Default) and then Languages.Values = Nil_String))
5234
        and then Project.Extends = No_Project
5235
      then
5236
         Project.Object_Directory := No_Path_Information;
5237
      else
5238
         Project.Object_Directory := Project.Directory;
5239
      end if;
5240
 
5241
      --  Check the object directory
5242
 
5243
      if Object_Dir.Value /= Empty_String then
5244
         Get_Name_String (Object_Dir.Value);
5245
 
5246
         if Name_Len = 0 then
5247
            Error_Msg
5248
              (Data.Flags,
5249
               "Object_Dir cannot be empty",
5250
               Object_Dir.Location, Project);
5251
 
5252
         else
5253
            --  We check that the specified object directory does exist.
5254
            --  However, even when it doesn't exist, we set it to a default
5255
            --  value. This is for the benefit of tools that recover from
5256
            --  errors; for example, these tools could create the non existent
5257
            --  directory. We always return an absolute directory name though.
5258
 
5259
            Locate_Directory
5260
              (Project,
5261
               File_Name_Type (Object_Dir.Value),
5262
               Path             => Project.Object_Directory,
5263
               Create           => "object",
5264
               Dir_Exists       => Dir_Exists,
5265
               Data             => Data,
5266
               Location         => Object_Dir.Location,
5267
               Must_Exist       => False,
5268
               Externally_Built => Project.Externally_Built);
5269
 
5270
            if not Dir_Exists
5271
              and then not Project.Externally_Built
5272
            then
5273
               --  The object directory does not exist, report an error if
5274
               --  the project is not externally built.
5275
 
5276
               Err_Vars.Error_Msg_File_1 :=
5277
                 File_Name_Type (Object_Dir.Value);
5278
 
5279
               case Data.Flags.Require_Obj_Dirs is
5280
                  when Error =>
5281
                     Error_Msg
5282
                       (Data.Flags,
5283
                        "object directory { not found",
5284
                        Project.Location, Project);
5285
                  when Warning =>
5286
                     Error_Msg
5287
                       (Data.Flags,
5288
                        "?object directory { not found",
5289
                        Project.Location, Project);
5290
                  when Silent =>
5291
                     null;
5292
               end case;
5293
            end if;
5294
         end if;
5295
 
5296
      elsif Project.Object_Directory /= No_Path_Information
5297
        and then Subdirs /= null
5298
      then
5299
         Name_Len := 1;
5300
         Name_Buffer (1) := '.';
5301
         Locate_Directory
5302
           (Project,
5303
            Name_Find,
5304
            Path             => Project.Object_Directory,
5305
            Create           => "object",
5306
            Dir_Exists       => Dir_Exists,
5307
            Data             => Data,
5308
            Location         => Object_Dir.Location,
5309
            Externally_Built => Project.Externally_Built);
5310
      end if;
5311
 
5312
      if Current_Verbosity = High then
5313
         if Project.Object_Directory = No_Path_Information then
5314
            Write_Line ("No object directory");
5315
         else
5316
            Write_Attr
5317
              ("Object directory",
5318
               Get_Name_String (Project.Object_Directory.Display_Name));
5319
         end if;
5320
      end if;
5321
 
5322
      --  Check the exec directory
5323
 
5324
      --  We set the object directory to its default
5325
 
5326
      Project.Exec_Directory   := Project.Object_Directory;
5327
 
5328
      if Exec_Dir.Value /= Empty_String then
5329
         Get_Name_String (Exec_Dir.Value);
5330
 
5331
         if Name_Len = 0 then
5332
            Error_Msg
5333
              (Data.Flags,
5334
               "Exec_Dir cannot be empty",
5335
               Exec_Dir.Location, Project);
5336
 
5337
         else
5338
            --  We check that the specified exec directory does exist
5339
 
5340
            Locate_Directory
5341
              (Project,
5342
               File_Name_Type (Exec_Dir.Value),
5343
               Path             => Project.Exec_Directory,
5344
               Dir_Exists       => Dir_Exists,
5345
               Data             => Data,
5346
               Create           => "exec",
5347
               Location         => Exec_Dir.Location,
5348
               Externally_Built => Project.Externally_Built);
5349
 
5350
            if not Dir_Exists then
5351
               Err_Vars.Error_Msg_File_1 := File_Name_Type (Exec_Dir.Value);
5352
               Error_Msg
5353
                 (Data.Flags,
5354
                  "exec directory { not found",
5355
                  Project.Location, Project);
5356
            end if;
5357
         end if;
5358
      end if;
5359
 
5360
      if Current_Verbosity = High then
5361
         if Project.Exec_Directory = No_Path_Information then
5362
            Write_Line ("No exec directory");
5363
         else
5364
            Write_Str ("Exec directory: """);
5365
            Write_Str (Get_Name_String (Project.Exec_Directory.Display_Name));
5366
            Write_Line ("""");
5367
         end if;
5368
      end if;
5369
 
5370
      --  Look for the source directories
5371
 
5372
      if Current_Verbosity = High then
5373
         Write_Line ("Starting to look for source directories");
5374
      end if;
5375
 
5376
      pragma Assert (Source_Dirs.Kind = List, "Source_Dirs is not a list");
5377
 
5378
      if (not Source_Files.Default)
5379
        and then Source_Files.Values = Nil_String
5380
      then
5381
         Project.Source_Dirs := Nil_String;
5382
 
5383
         if Project.Qualifier = Standard then
5384
            Error_Msg
5385
              (Data.Flags,
5386
               "a standard project cannot have no sources",
5387
               Source_Files.Location, Project);
5388
         end if;
5389
 
5390
      elsif Source_Dirs.Default then
5391
 
5392
         --  No Source_Dirs specified: the single source directory is the one
5393
         --  containing the project file.
5394
 
5395
         String_Element_Table.Append (Data.Tree.String_Elements,
5396
           (Value         => Name_Id (Project.Directory.Name),
5397
            Display_Value => Name_Id (Project.Directory.Display_Name),
5398
            Location      => No_Location,
5399
            Flag          => False,
5400
            Next          => Nil_String,
5401
            Index         => 0));
5402
 
5403
         Project.Source_Dirs :=
5404
           String_Element_Table.Last (Data.Tree.String_Elements);
5405
 
5406
         Number_List_Table.Append
5407
           (Data.Tree.Number_Lists,
5408
            (Number => 1, Next => No_Number_List));
5409
 
5410
         Project.Source_Dir_Ranks :=
5411
           Number_List_Table.Last (Data.Tree.Number_Lists);
5412
 
5413
         if Current_Verbosity = High then
5414
            Write_Attr
5415
              ("Default source directory",
5416
               Get_Name_String (Project.Directory.Display_Name));
5417
         end if;
5418
 
5419
      elsif Source_Dirs.Values = Nil_String then
5420
         if Project.Qualifier = Standard then
5421
            Error_Msg
5422
              (Data.Flags,
5423
               "a standard project cannot have no source directories",
5424
               Source_Dirs.Location, Project);
5425
         end if;
5426
 
5427
         Project.Source_Dirs := Nil_String;
5428
 
5429
      else
5430
         declare
5431
            Source_Dir : String_List_Id;
5432
            Element    : String_Element;
5433
            Rank       : Natural;
5434
         begin
5435
            --  Process the source directories for each element of the list
5436
 
5437
            Source_Dir := Source_Dirs.Values;
5438
            Rank := 0;
5439
            while Source_Dir /= Nil_String loop
5440
               Element := Data.Tree.String_Elements.Table (Source_Dir);
5441
               Rank := Rank + 1;
5442
               Find_Source_Dirs
5443
                 (File_Name_Type (Element.Value), Element.Location, Rank);
5444
               Source_Dir := Element.Next;
5445
            end loop;
5446
         end;
5447
      end if;
5448
 
5449
      if not Excluded_Source_Dirs.Default
5450
        and then Excluded_Source_Dirs.Values /= Nil_String
5451
      then
5452
         declare
5453
            Source_Dir : String_List_Id;
5454
            Element    : String_Element;
5455
 
5456
         begin
5457
            --  Process the source directories for each element of the list
5458
 
5459
            Source_Dir := Excluded_Source_Dirs.Values;
5460
            while Source_Dir /= Nil_String loop
5461
               Element := Data.Tree.String_Elements.Table (Source_Dir);
5462
               Find_Source_Dirs
5463
                 (File_Name_Type (Element.Value),
5464
                  Element.Location,
5465
                  0,
5466
                  Removed => True);
5467
               Source_Dir := Element.Next;
5468
            end loop;
5469
         end;
5470
      end if;
5471
 
5472
      if Current_Verbosity = High then
5473
         Write_Line ("Putting source directories in canonical cases");
5474
      end if;
5475
 
5476
      declare
5477
         Current : String_List_Id := Project.Source_Dirs;
5478
         Element : String_Element;
5479
 
5480
      begin
5481
         while Current /= Nil_String loop
5482
            Element := Data.Tree.String_Elements.Table (Current);
5483
            if Element.Value /= No_Name then
5484
               Element.Value :=
5485
                 Name_Id (Canonical_Case_File_Name (Name_Id (Element.Value)));
5486
               Data.Tree.String_Elements.Table (Current) := Element;
5487
            end if;
5488
 
5489
            Current := Element.Next;
5490
         end loop;
5491
      end;
5492
   end Get_Directories;
5493
 
5494
   ---------------
5495
   -- Get_Mains --
5496
   ---------------
5497
 
5498
   procedure Get_Mains
5499
     (Project : Project_Id;
5500
      Data    : in out Tree_Processing_Data)
5501
   is
5502
      Mains : constant Variable_Value :=
5503
               Prj.Util.Value_Of
5504
                 (Name_Main, Project.Decl.Attributes, Data.Tree);
5505
      List  : String_List_Id;
5506
      Elem  : String_Element;
5507
 
5508
   begin
5509
      Project.Mains := Mains.Values;
5510
 
5511
      --  If no Mains were specified, and if we are an extending project,
5512
      --  inherit the Mains from the project we are extending.
5513
 
5514
      if Mains.Default then
5515
         if not Project.Library and then Project.Extends /= No_Project then
5516
            Project.Mains := Project.Extends.Mains;
5517
         end if;
5518
 
5519
      --  In a library project file, Main cannot be specified
5520
 
5521
      elsif Project.Library then
5522
         Error_Msg
5523
           (Data.Flags,
5524
            "a library project file cannot have Main specified",
5525
            Mains.Location, Project);
5526
 
5527
      else
5528
         List := Mains.Values;
5529
         while List /= Nil_String loop
5530
            Elem := Data.Tree.String_Elements.Table (List);
5531
 
5532
            if Length_Of_Name (Elem.Value) = 0 then
5533
               Error_Msg
5534
                 (Data.Flags,
5535
                  "?a main cannot have an empty name",
5536
                  Elem.Location, Project);
5537
               exit;
5538
            end if;
5539
 
5540
            List := Elem.Next;
5541
         end loop;
5542
      end if;
5543
   end Get_Mains;
5544
 
5545
   ---------------------------
5546
   -- Get_Sources_From_File --
5547
   ---------------------------
5548
 
5549
   procedure Get_Sources_From_File
5550
     (Path     : String;
5551
      Location : Source_Ptr;
5552
      Project  : in out Project_Processing_Data;
5553
      Data     : in out Tree_Processing_Data)
5554
   is
5555
      File        : Prj.Util.Text_File;
5556
      Line        : String (1 .. 250);
5557
      Last        : Natural;
5558
      Source_Name : File_Name_Type;
5559
      Name_Loc    : Name_Location;
5560
 
5561
   begin
5562
      if Current_Verbosity = High then
5563
         Write_Str  ("Opening """);
5564
         Write_Str  (Path);
5565
         Write_Line (""".");
5566
      end if;
5567
 
5568
      --  Open the file
5569
 
5570
      Prj.Util.Open (File, Path);
5571
 
5572
      if not Prj.Util.Is_Valid (File) then
5573
         Error_Msg
5574
           (Data.Flags, "file does not exist", Location, Project.Project);
5575
 
5576
      else
5577
         --  Read the lines one by one
5578
 
5579
         while not Prj.Util.End_Of_File (File) loop
5580
            Prj.Util.Get_Line (File, Line, Last);
5581
 
5582
            --  A non empty, non comment line should contain a file name
5583
 
5584
            if Last /= 0
5585
              and then (Last = 1 or else Line (1 .. 2) /= "--")
5586
            then
5587
               Name_Len := Last;
5588
               Name_Buffer (1 .. Name_Len) := Line (1 .. Last);
5589
               Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
5590
               Source_Name := Name_Find;
5591
 
5592
               --  Check that there is no directory information
5593
 
5594
               for J in 1 .. Last loop
5595
                  if Line (J) = '/' or else Line (J) = Directory_Separator then
5596
                     Error_Msg_File_1 := Source_Name;
5597
                     Error_Msg
5598
                       (Data.Flags,
5599
                        "file name cannot include directory information ({)",
5600
                        Location, Project.Project);
5601
                     exit;
5602
                  end if;
5603
               end loop;
5604
 
5605
               Name_Loc := Source_Names_Htable.Get
5606
                 (Project.Source_Names, Source_Name);
5607
 
5608
               if Name_Loc = No_Name_Location then
5609
                  Name_Loc :=
5610
                    (Name     => Source_Name,
5611
                     Location => Location,
5612
                     Source   => No_Source,
5613
                     Found    => False);
5614
               end if;
5615
 
5616
               Source_Names_Htable.Set
5617
                 (Project.Source_Names, Source_Name, Name_Loc);
5618
            end if;
5619
         end loop;
5620
 
5621
         Prj.Util.Close (File);
5622
 
5623
      end if;
5624
   end Get_Sources_From_File;
5625
 
5626
   -----------------------
5627
   -- Compute_Unit_Name --
5628
   -----------------------
5629
 
5630
   procedure Compute_Unit_Name
5631
     (File_Name : File_Name_Type;
5632
      Naming    : Lang_Naming_Data;
5633
      Kind      : out Source_Kind;
5634
      Unit      : out Name_Id;
5635
      Project   : Project_Processing_Data;
5636
      In_Tree   : Project_Tree_Ref)
5637
   is
5638
      Filename : constant String  := Get_Name_String (File_Name);
5639
      Last     : Integer          := Filename'Last;
5640
      Sep_Len  : Integer;
5641
      Body_Len : Integer;
5642
      Spec_Len : Integer;
5643
 
5644
      Unit_Except : Unit_Exception;
5645
      Masked      : Boolean  := False;
5646
 
5647
   begin
5648
      Unit := No_Name;
5649
      Kind := Spec;
5650
 
5651
      if Naming.Separate_Suffix = No_File
5652
        or else Naming.Body_Suffix = No_File
5653
        or else Naming.Spec_Suffix = No_File
5654
      then
5655
         return;
5656
      end if;
5657
 
5658
      if Naming.Dot_Replacement = No_File then
5659
         if Current_Verbosity = High then
5660
            Write_Line ("  No dot_replacement specified");
5661
         end if;
5662
 
5663
         return;
5664
      end if;
5665
 
5666
      Sep_Len  := Integer (Length_Of_Name (Naming.Separate_Suffix));
5667
      Spec_Len := Integer (Length_Of_Name (Naming.Spec_Suffix));
5668
      Body_Len := Integer (Length_Of_Name (Naming.Body_Suffix));
5669
 
5670
      --  Choose the longest suffix that matches. If there are several matches,
5671
      --  give priority to specs, then bodies, then separates.
5672
 
5673
      if Naming.Separate_Suffix /= Naming.Body_Suffix
5674
        and then Suffix_Matches (Filename, Naming.Separate_Suffix)
5675
      then
5676
         Last := Filename'Last - Sep_Len;
5677
         Kind := Sep;
5678
      end if;
5679
 
5680
      if Filename'Last - Body_Len <= Last
5681
        and then Suffix_Matches (Filename, Naming.Body_Suffix)
5682
      then
5683
         Last := Natural'Min (Last, Filename'Last - Body_Len);
5684
         Kind := Impl;
5685
      end if;
5686
 
5687
      if Filename'Last - Spec_Len <= Last
5688
        and then Suffix_Matches (Filename, Naming.Spec_Suffix)
5689
      then
5690
         Last := Natural'Min (Last, Filename'Last - Spec_Len);
5691
         Kind := Spec;
5692
      end if;
5693
 
5694
      if Last = Filename'Last then
5695
         if Current_Verbosity = High then
5696
            Write_Line ("     no matching suffix");
5697
         end if;
5698
 
5699
         return;
5700
      end if;
5701
 
5702
      --  Check that the casing matches
5703
 
5704
      if File_Names_Case_Sensitive then
5705
         case Naming.Casing is
5706
            when All_Lower_Case =>
5707
               for J in Filename'First .. Last loop
5708
                  if Is_Letter (Filename (J))
5709
                    and then not Is_Lower (Filename (J))
5710
                  then
5711
                     if Current_Verbosity = High then
5712
                        Write_Line ("  Invalid casing");
5713
                     end if;
5714
 
5715
                     return;
5716
                  end if;
5717
               end loop;
5718
 
5719
            when All_Upper_Case =>
5720
               for J in Filename'First .. Last loop
5721
                  if Is_Letter (Filename (J))
5722
                    and then not Is_Upper (Filename (J))
5723
                  then
5724
                     if Current_Verbosity = High then
5725
                        Write_Line ("  Invalid casing");
5726
                     end if;
5727
 
5728
                     return;
5729
                  end if;
5730
               end loop;
5731
 
5732
            when Mixed_Case | Unknown =>
5733
               null;
5734
         end case;
5735
      end if;
5736
 
5737
      --  If Dot_Replacement is not a single dot, then there should not
5738
      --  be any dot in the name.
5739
 
5740
      declare
5741
         Dot_Repl : constant String :=
5742
                      Get_Name_String (Naming.Dot_Replacement);
5743
 
5744
      begin
5745
         if Dot_Repl /= "." then
5746
            for Index in Filename'First .. Last loop
5747
               if Filename (Index) = '.' then
5748
                  if Current_Verbosity = High then
5749
                     Write_Line ("   Invalid name, contains dot");
5750
                  end if;
5751
 
5752
                  return;
5753
               end if;
5754
            end loop;
5755
 
5756
            Replace_Into_Name_Buffer
5757
              (Filename (Filename'First .. Last), Dot_Repl, '.');
5758
 
5759
         else
5760
            Name_Len := Last - Filename'First + 1;
5761
            Name_Buffer (1 .. Name_Len) := Filename (Filename'First .. Last);
5762
            Fixed.Translate
5763
              (Source  => Name_Buffer (1 .. Name_Len),
5764
               Mapping => Lower_Case_Map);
5765
         end if;
5766
      end;
5767
 
5768
      --  In the standard GNAT naming scheme, check for special cases: children
5769
      --  or separates of A, G, I or S, and run time sources.
5770
 
5771
      if Is_Standard_GNAT_Naming (Naming)
5772
        and then Name_Len >= 3
5773
      then
5774
         declare
5775
            S1 : constant Character := Name_Buffer (1);
5776
            S2 : constant Character := Name_Buffer (2);
5777
            S3 : constant Character := Name_Buffer (3);
5778
 
5779
         begin
5780
            if        S1 = 'a'
5781
              or else S1 = 'g'
5782
              or else S1 = 'i'
5783
              or else S1 = 's'
5784
            then
5785
               --  Children or separates of packages A, G, I or S. These names
5786
               --  are x__ ... or x~... (where x is a, g, i, or s). Both
5787
               --  versions (x__... and x~...) are allowed in all platforms,
5788
               --  because it is not possible to know the platform before
5789
               --  processing of the project files.
5790
 
5791
               if S2 = '_' and then S3 = '_' then
5792
                  Name_Buffer (2) := '.';
5793
                  Name_Buffer (3 .. Name_Len - 1) :=
5794
                    Name_Buffer (4 .. Name_Len);
5795
                  Name_Len := Name_Len - 1;
5796
 
5797
               elsif S2 = '~' then
5798
                  Name_Buffer (2) := '.';
5799
 
5800
               elsif S2 = '.' then
5801
 
5802
                  --  If it is potentially a run time source
5803
 
5804
                  null;
5805
               end if;
5806
            end if;
5807
         end;
5808
      end if;
5809
 
5810
      --  Name_Buffer contains the name of the the unit in lower-cases. Check
5811
      --  that this is a valid unit name
5812
 
5813
      Check_Ada_Name (Name_Buffer (1 .. Name_Len), Unit);
5814
 
5815
      --  If there is a naming exception for the same unit, the file is not
5816
      --  a source for the unit.
5817
 
5818
      if Unit /= No_Name then
5819
         Unit_Except :=
5820
           Unit_Exceptions_Htable.Get (Project.Unit_Exceptions, Unit);
5821
 
5822
         if Kind = Spec then
5823
            Masked := Unit_Except.Spec /= No_File
5824
                        and then
5825
                      Unit_Except.Spec /= File_Name;
5826
         else
5827
            Masked := Unit_Except.Impl /= No_File
5828
                        and then
5829
                      Unit_Except.Impl /= File_Name;
5830
         end if;
5831
 
5832
         if Masked then
5833
            if Current_Verbosity = High then
5834
               Write_Str ("   """ & Filename & """ contains the ");
5835
 
5836
               if Kind = Spec then
5837
                  Write_Str ("spec of a unit found in """);
5838
                  Write_Str (Get_Name_String (Unit_Except.Spec));
5839
               else
5840
                  Write_Str ("body of a unit found in """);
5841
                  Write_Str (Get_Name_String (Unit_Except.Impl));
5842
               end if;
5843
 
5844
               Write_Line (""" (ignored)");
5845
            end if;
5846
 
5847
            Unit := No_Name;
5848
         end if;
5849
      end if;
5850
 
5851
      if Unit /= No_Name
5852
        and then Current_Verbosity = High
5853
      then
5854
         case Kind is
5855
            when Spec => Write_Str ("   spec of ");
5856
            when Impl => Write_Str ("   body of ");
5857
            when Sep  => Write_Str ("   sep of ");
5858
         end case;
5859
 
5860
         Write_Line (Get_Name_String (Unit));
5861
      end if;
5862
   end Compute_Unit_Name;
5863
 
5864
   --------------------------
5865
   -- Check_Illegal_Suffix --
5866
   --------------------------
5867
 
5868
   procedure Check_Illegal_Suffix
5869
     (Project         : Project_Id;
5870
      Suffix          : File_Name_Type;
5871
      Dot_Replacement : File_Name_Type;
5872
      Attribute_Name  : String;
5873
      Location        : Source_Ptr;
5874
      Data            : in out Tree_Processing_Data)
5875
   is
5876
      Suffix_Str : constant String := Get_Name_String (Suffix);
5877
 
5878
   begin
5879
      if Suffix_Str'Length = 0 then
5880
 
5881
         --  Always valid
5882
 
5883
         return;
5884
 
5885
      elsif Index (Suffix_Str, ".") = 0 then
5886
         Err_Vars.Error_Msg_File_1 := Suffix;
5887
         Error_Msg
5888
           (Data.Flags,
5889
            "{ is illegal for " & Attribute_Name & ": must have a dot",
5890
            Location, Project);
5891
         return;
5892
      end if;
5893
 
5894
      --  Case of dot replacement is a single dot, and first character of
5895
      --  suffix is also a dot.
5896
 
5897
      if Dot_Replacement /= No_File
5898
        and then Get_Name_String (Dot_Replacement) = "."
5899
        and then Suffix_Str (Suffix_Str'First) = '.'
5900
      then
5901
         for Index in Suffix_Str'First + 1 .. Suffix_Str'Last loop
5902
 
5903
            --  If there are multiple dots in the name
5904
 
5905
            if Suffix_Str (Index) = '.' then
5906
 
5907
               --  It is illegal to have a letter following the initial dot
5908
 
5909
               if Is_Letter (Suffix_Str (Suffix_Str'First + 1)) then
5910
                  Err_Vars.Error_Msg_File_1 := Suffix;
5911
                  Error_Msg
5912
                    (Data.Flags,
5913
                     "{ is illegal for " & Attribute_Name
5914
                     & ": ambiguous prefix when Dot_Replacement is a dot",
5915
                     Location, Project);
5916
               end if;
5917
               return;
5918
            end if;
5919
         end loop;
5920
      end if;
5921
   end Check_Illegal_Suffix;
5922
 
5923
   ----------------------
5924
   -- Locate_Directory --
5925
   ----------------------
5926
 
5927
   procedure Locate_Directory
5928
     (Project          : Project_Id;
5929
      Name             : File_Name_Type;
5930
      Path             : out Path_Information;
5931
      Dir_Exists       : out Boolean;
5932
      Data             : in out Tree_Processing_Data;
5933
      Create           : String := "";
5934
      Location         : Source_Ptr := No_Location;
5935
      Must_Exist       : Boolean := True;
5936
      Externally_Built : Boolean := False)
5937
   is
5938
      Parent          : constant Path_Name_Type :=
5939
                          Project.Directory.Display_Name;
5940
      The_Parent      : constant String :=
5941
                          Get_Name_String (Parent);
5942
      The_Parent_Last : constant Natural :=
5943
                          Compute_Directory_Last (The_Parent);
5944
      Full_Name       : File_Name_Type;
5945
      The_Name        : File_Name_Type;
5946
 
5947
   begin
5948
      Get_Name_String (Name);
5949
 
5950
      --  Add Subdirs.all if it is a directory that may be created and
5951
      --  Subdirs is not null;
5952
 
5953
      if Create /= "" and then Subdirs /= null then
5954
         if Name_Buffer (Name_Len) /= Directory_Separator then
5955
            Add_Char_To_Name_Buffer (Directory_Separator);
5956
         end if;
5957
 
5958
         Add_Str_To_Name_Buffer (Subdirs.all);
5959
      end if;
5960
 
5961
      --  Convert '/' to directory separator (for Windows)
5962
 
5963
      for J in 1 .. Name_Len loop
5964
         if Name_Buffer (J) = '/' then
5965
            Name_Buffer (J) := Directory_Separator;
5966
         end if;
5967
      end loop;
5968
 
5969
      The_Name := Name_Find;
5970
 
5971
      if Current_Verbosity = High then
5972
         Write_Str ("Locate_Directory (""");
5973
         Write_Str (Get_Name_String (The_Name));
5974
         Write_Str (""", """);
5975
         Write_Str (The_Parent);
5976
         Write_Line (""")");
5977
      end if;
5978
 
5979
      Path := No_Path_Information;
5980
      Dir_Exists := False;
5981
 
5982
      if Is_Absolute_Path (Get_Name_String (The_Name)) then
5983
         Full_Name := The_Name;
5984
 
5985
      else
5986
         Name_Len := 0;
5987
         Add_Str_To_Name_Buffer
5988
           (The_Parent (The_Parent'First .. The_Parent_Last));
5989
         Add_Str_To_Name_Buffer (Get_Name_String (The_Name));
5990
         Full_Name := Name_Find;
5991
      end if;
5992
 
5993
      declare
5994
         Full_Path_Name : String_Access :=
5995
                            new String'(Get_Name_String (Full_Name));
5996
 
5997
      begin
5998
         if (Setup_Projects or else Subdirs /= null)
5999
           and then Create'Length > 0
6000
         then
6001
            if not Is_Directory (Full_Path_Name.all) then
6002
 
6003
               --  If project is externally built, do not create a subdir,
6004
               --  use the specified directory, without the subdir.
6005
 
6006
               if Externally_Built then
6007
                  if Is_Absolute_Path (Get_Name_String (Name)) then
6008
                     Get_Name_String (Name);
6009
 
6010
                  else
6011
                     Name_Len := 0;
6012
                     Add_Str_To_Name_Buffer
6013
                       (The_Parent (The_Parent'First .. The_Parent_Last));
6014
                     Add_Str_To_Name_Buffer (Get_Name_String (Name));
6015
                  end if;
6016
 
6017
                  Full_Path_Name := new String'(Name_Buffer (1 .. Name_Len));
6018
 
6019
               else
6020
                  begin
6021
                     Create_Path (Full_Path_Name.all);
6022
 
6023
                     if not Quiet_Output then
6024
                        Write_Str (Create);
6025
                        Write_Str (" directory """);
6026
                        Write_Str (Full_Path_Name.all);
6027
                        Write_Str (""" created for project ");
6028
                        Write_Line (Get_Name_String (Project.Name));
6029
                     end if;
6030
 
6031
                  exception
6032
                     when Use_Error =>
6033
                        Error_Msg
6034
                          (Data.Flags,
6035
                           "could not create " & Create &
6036
                           " directory " & Full_Path_Name.all,
6037
                           Location, Project);
6038
                  end;
6039
               end if;
6040
            end if;
6041
         end if;
6042
 
6043
         Dir_Exists := Is_Directory (Full_Path_Name.all);
6044
 
6045
         if not Must_Exist or else Dir_Exists then
6046
            declare
6047
               Normed : constant String :=
6048
                          Normalize_Pathname
6049
                            (Full_Path_Name.all,
6050
                             Directory      =>
6051
                              The_Parent (The_Parent'First .. The_Parent_Last),
6052
                             Resolve_Links  => False,
6053
                             Case_Sensitive => True);
6054
 
6055
               Canonical_Path : constant String :=
6056
                                  Normalize_Pathname
6057
                                    (Normed,
6058
                                     Directory      =>
6059
                                       The_Parent
6060
                                         (The_Parent'First .. The_Parent_Last),
6061
                                     Resolve_Links  =>
6062
                                        Opt.Follow_Links_For_Dirs,
6063
                                     Case_Sensitive => False);
6064
 
6065
            begin
6066
               Name_Len := Normed'Length;
6067
               Name_Buffer (1 .. Name_Len) := Normed;
6068
 
6069
               --  Directories should always end with a directory separator
6070
 
6071
               if Name_Buffer (Name_Len) /= Directory_Separator then
6072
                  Add_Char_To_Name_Buffer (Directory_Separator);
6073
               end if;
6074
 
6075
               Path.Display_Name := Name_Find;
6076
 
6077
               Name_Len := Canonical_Path'Length;
6078
               Name_Buffer (1 .. Name_Len) := Canonical_Path;
6079
 
6080
               if Name_Buffer (Name_Len) /= Directory_Separator then
6081
                  Add_Char_To_Name_Buffer (Directory_Separator);
6082
               end if;
6083
 
6084
               Path.Name := Name_Find;
6085
            end;
6086
         end if;
6087
 
6088
         Free (Full_Path_Name);
6089
      end;
6090
   end Locate_Directory;
6091
 
6092
   ---------------------------
6093
   -- Find_Excluded_Sources --
6094
   ---------------------------
6095
 
6096
   procedure Find_Excluded_Sources
6097
     (Project : in out Project_Processing_Data;
6098
      Data    : in out Tree_Processing_Data)
6099
   is
6100
      Excluded_Source_List_File : constant Variable_Value :=
6101
                                    Util.Value_Of
6102
                                      (Name_Excluded_Source_List_File,
6103
                                       Project.Project.Decl.Attributes,
6104
                                       Data.Tree);
6105
      Excluded_Sources          : Variable_Value := Util.Value_Of
6106
                                    (Name_Excluded_Source_Files,
6107
                                     Project.Project.Decl.Attributes,
6108
                                     Data.Tree);
6109
 
6110
      Current         : String_List_Id;
6111
      Element         : String_Element;
6112
      Location        : Source_Ptr;
6113
      Name            : File_Name_Type;
6114
      File            : Prj.Util.Text_File;
6115
      Line            : String (1 .. 300);
6116
      Last            : Natural;
6117
      Locally_Removed : Boolean := False;
6118
 
6119
   begin
6120
      --  If Excluded_Source_Files is not declared, check Locally_Removed_Files
6121
 
6122
      if Excluded_Sources.Default then
6123
         Locally_Removed := True;
6124
         Excluded_Sources :=
6125
           Util.Value_Of
6126
             (Name_Locally_Removed_Files,
6127
              Project.Project.Decl.Attributes, Data.Tree);
6128
      end if;
6129
 
6130
      --  If there are excluded sources, put them in the table
6131
 
6132
      if not Excluded_Sources.Default then
6133
         if not Excluded_Source_List_File.Default then
6134
            if Locally_Removed then
6135
               Error_Msg
6136
                 (Data.Flags,
6137
                  "?both attributes Locally_Removed_Files and " &
6138
                  "Excluded_Source_List_File are present",
6139
                  Excluded_Source_List_File.Location, Project.Project);
6140
            else
6141
               Error_Msg
6142
                 (Data.Flags,
6143
                  "?both attributes Excluded_Source_Files and " &
6144
                  "Excluded_Source_List_File are present",
6145
                  Excluded_Source_List_File.Location, Project.Project);
6146
            end if;
6147
         end if;
6148
 
6149
         Current := Excluded_Sources.Values;
6150
         while Current /= Nil_String loop
6151
            Element := Data.Tree.String_Elements.Table (Current);
6152
            Name := Canonical_Case_File_Name (Element.Value);
6153
 
6154
            --  If the element has no location, then use the location of
6155
            --  Excluded_Sources to report possible errors.
6156
 
6157
            if Element.Location = No_Location then
6158
               Location := Excluded_Sources.Location;
6159
            else
6160
               Location := Element.Location;
6161
            end if;
6162
 
6163
            Excluded_Sources_Htable.Set
6164
              (Project.Excluded, Name, (Name, False, Location));
6165
            Current := Element.Next;
6166
         end loop;
6167
 
6168
      elsif not Excluded_Source_List_File.Default then
6169
         Location := Excluded_Source_List_File.Location;
6170
 
6171
         declare
6172
            Source_File_Path_Name : constant String :=
6173
                                      Path_Name_Of
6174
                                        (File_Name_Type
6175
                                           (Excluded_Source_List_File.Value),
6176
                                         Project.Project.Directory.Name);
6177
 
6178
         begin
6179
            if Source_File_Path_Name'Length = 0 then
6180
               Err_Vars.Error_Msg_File_1 :=
6181
                 File_Name_Type (Excluded_Source_List_File.Value);
6182
               Error_Msg
6183
                 (Data.Flags,
6184
                  "file with excluded sources { does not exist",
6185
                  Excluded_Source_List_File.Location, Project.Project);
6186
 
6187
            else
6188
               --  Open the file
6189
 
6190
               Prj.Util.Open (File, Source_File_Path_Name);
6191
 
6192
               if not Prj.Util.Is_Valid (File) then
6193
                  Error_Msg
6194
                    (Data.Flags, "file does not exist",
6195
                     Location, Project.Project);
6196
               else
6197
                  --  Read the lines one by one
6198
 
6199
                  while not Prj.Util.End_Of_File (File) loop
6200
                     Prj.Util.Get_Line (File, Line, Last);
6201
 
6202
                     --  Non empty, non comment line should contain a file name
6203
 
6204
                     if Last /= 0
6205
                       and then (Last = 1 or else Line (1 .. 2) /= "--")
6206
                     then
6207
                        Name_Len := Last;
6208
                        Name_Buffer (1 .. Name_Len) := Line (1 .. Last);
6209
                        Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
6210
                        Name := Name_Find;
6211
 
6212
                        --  Check that there is no directory information
6213
 
6214
                        for J in 1 .. Last loop
6215
                           if Line (J) = '/'
6216
                             or else Line (J) = Directory_Separator
6217
                           then
6218
                              Error_Msg_File_1 := Name;
6219
                              Error_Msg
6220
                                (Data.Flags,
6221
                                 "file name cannot include " &
6222
                                 "directory information ({)",
6223
                                 Location, Project.Project);
6224
                              exit;
6225
                           end if;
6226
                        end loop;
6227
 
6228
                        Excluded_Sources_Htable.Set
6229
                          (Project.Excluded, Name, (Name, False, Location));
6230
                     end if;
6231
                  end loop;
6232
 
6233
                  Prj.Util.Close (File);
6234
               end if;
6235
            end if;
6236
         end;
6237
      end if;
6238
   end Find_Excluded_Sources;
6239
 
6240
   ------------------
6241
   -- Find_Sources --
6242
   ------------------
6243
 
6244
   procedure Find_Sources
6245
     (Project   : in out Project_Processing_Data;
6246
      Data      : in out Tree_Processing_Data)
6247
   is
6248
      Sources : constant Variable_Value :=
6249
                  Util.Value_Of
6250
                    (Name_Source_Files,
6251
                    Project.Project.Decl.Attributes,
6252
                    Data.Tree);
6253
 
6254
      Source_List_File : constant Variable_Value :=
6255
                           Util.Value_Of
6256
                             (Name_Source_List_File,
6257
                              Project.Project.Decl.Attributes,
6258
                              Data.Tree);
6259
 
6260
      Name_Loc             : Name_Location;
6261
      Has_Explicit_Sources : Boolean;
6262
 
6263
   begin
6264
      pragma Assert (Sources.Kind = List, "Source_Files is not a list");
6265
      pragma Assert
6266
        (Source_List_File.Kind = Single,
6267
         "Source_List_File is not a single string");
6268
 
6269
      Project.Source_List_File_Location := Source_List_File.Location;
6270
 
6271
      --  If the user has specified a Source_Files attribute
6272
 
6273
      if not Sources.Default then
6274
         if not Source_List_File.Default then
6275
            Error_Msg
6276
              (Data.Flags,
6277
               "?both attributes source_files and " &
6278
               "source_list_file are present",
6279
               Source_List_File.Location, Project.Project);
6280
         end if;
6281
 
6282
         --  Sources is a list of file names
6283
 
6284
         declare
6285
            Current  : String_List_Id := Sources.Values;
6286
            Element  : String_Element;
6287
            Location : Source_Ptr;
6288
            Name     : File_Name_Type;
6289
 
6290
         begin
6291
            if Current = Nil_String then
6292
               Project.Project.Languages := No_Language_Index;
6293
 
6294
               --  This project contains no source. For projects that don't
6295
               --  extend other projects, this also means that there is no
6296
               --  need for an object directory, if not specified.
6297
 
6298
               if Project.Project.Extends = No_Project
6299
                 and then Project.Project.Object_Directory =
6300
                   Project.Project.Directory
6301
               then
6302
                  Project.Project.Object_Directory := No_Path_Information;
6303
               end if;
6304
            end if;
6305
 
6306
            while Current /= Nil_String loop
6307
               Element := Data.Tree.String_Elements.Table (Current);
6308
               Name := Canonical_Case_File_Name (Element.Value);
6309
               Get_Name_String (Element.Value);
6310
 
6311
               --  If the element has no location, then use the location of
6312
               --  Sources to report possible errors.
6313
 
6314
               if Element.Location = No_Location then
6315
                  Location := Sources.Location;
6316
               else
6317
                  Location := Element.Location;
6318
               end if;
6319
 
6320
               --  Check that there is no directory information
6321
 
6322
               for J in 1 .. Name_Len loop
6323
                  if Name_Buffer (J) = '/'
6324
                    or else Name_Buffer (J) = Directory_Separator
6325
                  then
6326
                     Error_Msg_File_1 := Name;
6327
                     Error_Msg
6328
                       (Data.Flags,
6329
                        "file name cannot include directory " &
6330
                        "information ({)",
6331
                        Location, Project.Project);
6332
                     exit;
6333
                  end if;
6334
               end loop;
6335
 
6336
               --  Check whether the file is already there: the same file name
6337
               --  may be in the list. If the source is missing, the error will
6338
               --  be on the first mention of the source file name.
6339
 
6340
               Name_Loc := Source_Names_Htable.Get
6341
                 (Project.Source_Names, Name);
6342
 
6343
               if Name_Loc = No_Name_Location then
6344
                  Name_Loc :=
6345
                    (Name     => Name,
6346
                     Location => Location,
6347
                     Source   => No_Source,
6348
                     Found    => False);
6349
                  Source_Names_Htable.Set
6350
                    (Project.Source_Names, Name, Name_Loc);
6351
               end if;
6352
 
6353
               Current := Element.Next;
6354
            end loop;
6355
 
6356
            Has_Explicit_Sources := True;
6357
         end;
6358
 
6359
         --  If we have no Source_Files attribute, check the Source_List_File
6360
         --  attribute.
6361
 
6362
      elsif not Source_List_File.Default then
6363
 
6364
         --  Source_List_File is the name of the file that contains the source
6365
         --  file names.
6366
 
6367
         declare
6368
            Source_File_Path_Name : constant String :=
6369
              Path_Name_Of
6370
                (File_Name_Type (Source_List_File.Value),
6371
                 Project.Project.Directory.Name);
6372
 
6373
         begin
6374
            Has_Explicit_Sources := True;
6375
 
6376
            if Source_File_Path_Name'Length = 0 then
6377
               Err_Vars.Error_Msg_File_1 :=
6378
                 File_Name_Type (Source_List_File.Value);
6379
               Error_Msg
6380
                 (Data.Flags,
6381
                  "file with sources { does not exist",
6382
                  Source_List_File.Location, Project.Project);
6383
 
6384
            else
6385
               Get_Sources_From_File
6386
                 (Source_File_Path_Name, Source_List_File.Location,
6387
                  Project, Data);
6388
            end if;
6389
         end;
6390
 
6391
      else
6392
         --  Neither Source_Files nor Source_List_File has been specified. Find
6393
         --  all the files that satisfy the naming scheme in all the source
6394
         --  directories.
6395
 
6396
         Has_Explicit_Sources := False;
6397
      end if;
6398
 
6399
      Search_Directories
6400
        (Project,
6401
         Data            => Data,
6402
         For_All_Sources => Sources.Default and then Source_List_File.Default);
6403
 
6404
      --  Check if all exceptions have been found
6405
 
6406
      declare
6407
         Source : Source_Id;
6408
         Iter   : Source_Iterator;
6409
 
6410
      begin
6411
         Iter := For_Each_Source (Data.Tree, Project.Project);
6412
         loop
6413
            Source := Prj.Element (Iter);
6414
            exit when Source = No_Source;
6415
 
6416
            if Source.Naming_Exception
6417
              and then Source.Path = No_Path_Information
6418
            then
6419
               if Source.Unit /= No_Unit_Index then
6420
 
6421
                  --  For multi-unit source files, source_id gets duplicated
6422
                  --  once for every unit. Only the first source_id got its
6423
                  --  full path set. So if it isn't set for that first one,
6424
                  --  the file wasn't found. Otherwise we need to update for
6425
                  --  units after the first one.
6426
 
6427
                  if Source.Index = 0
6428
                    or else Source.Index = 1
6429
                  then
6430
                     Error_Msg_Name_1 := Name_Id (Source.Display_File);
6431
                     Error_Msg_Name_2 := Name_Id (Source.Unit.Name);
6432
                     Error_Msg
6433
                       (Data.Flags,
6434
                        "source file %% for unit %% not found",
6435
                        No_Location, Project.Project);
6436
 
6437
                  else
6438
                     Source.Path := Files_Htable.Get
6439
                       (Data.File_To_Source, Source.File).Path;
6440
 
6441
                     if Current_Verbosity = High then
6442
                        if Source.Path /= No_Path_Information then
6443
                           Write_Line ("Setting full path for "
6444
                                       & Get_Name_String (Source.File)
6445
                                       & " at" & Source.Index'Img
6446
                                       & " to "
6447
                                       & Get_Name_String (Source.Path.Name));
6448
                        end if;
6449
                     end if;
6450
                  end if;
6451
               end if;
6452
 
6453
               if Source.Path = No_Path_Information then
6454
                  Remove_Source (Source, No_Source);
6455
               end if;
6456
            end if;
6457
 
6458
            Next (Iter);
6459
         end loop;
6460
      end;
6461
 
6462
      --  It is an error if a source file name in a source list or in a source
6463
      --  list file is not found.
6464
 
6465
      if Has_Explicit_Sources then
6466
         declare
6467
            NL          : Name_Location;
6468
            First_Error : Boolean;
6469
 
6470
         begin
6471
            NL := Source_Names_Htable.Get_First (Project.Source_Names);
6472
            First_Error := True;
6473
            while NL /= No_Name_Location loop
6474
               if not NL.Found then
6475
                  Err_Vars.Error_Msg_File_1 := NL.Name;
6476
 
6477
                  if First_Error then
6478
                     Error_Msg
6479
                       (Data.Flags,
6480
                        "source file { not found",
6481
                        NL.Location, Project.Project);
6482
                     First_Error := False;
6483
 
6484
                  else
6485
                     Error_Msg
6486
                       (Data.Flags,
6487
                        "\source file { not found",
6488
                        NL.Location, Project.Project);
6489
                  end if;
6490
               end if;
6491
 
6492
               NL := Source_Names_Htable.Get_Next (Project.Source_Names);
6493
            end loop;
6494
         end;
6495
      end if;
6496
   end Find_Sources;
6497
 
6498
   ----------------
6499
   -- Initialize --
6500
   ----------------
6501
 
6502
   procedure Initialize
6503
     (Data  : out Tree_Processing_Data;
6504
      Tree  : Project_Tree_Ref;
6505
      Flags : Prj.Processing_Flags)
6506
   is
6507
   begin
6508
      Files_Htable.Reset (Data.File_To_Source);
6509
      Data.Tree  := Tree;
6510
      Data.Flags := Flags;
6511
   end Initialize;
6512
 
6513
   ----------
6514
   -- Free --
6515
   ----------
6516
 
6517
   procedure Free (Data : in out Tree_Processing_Data) is
6518
   begin
6519
      Files_Htable.Reset (Data.File_To_Source);
6520
   end Free;
6521
 
6522
   ----------------
6523
   -- Initialize --
6524
   ----------------
6525
 
6526
   procedure Initialize
6527
     (Data    : in out Project_Processing_Data;
6528
      Project : Project_Id)
6529
   is
6530
   begin
6531
      Data.Project := Project;
6532
   end Initialize;
6533
 
6534
   ----------
6535
   -- Free --
6536
   ----------
6537
 
6538
   procedure Free (Data : in out Project_Processing_Data) is
6539
   begin
6540
      Source_Names_Htable.Reset      (Data.Source_Names);
6541
      Unit_Exceptions_Htable.Reset   (Data.Unit_Exceptions);
6542
      Excluded_Sources_Htable.Reset  (Data.Excluded);
6543
   end Free;
6544
 
6545
   -------------------------------
6546
   -- Check_File_Naming_Schemes --
6547
   -------------------------------
6548
 
6549
   procedure Check_File_Naming_Schemes
6550
     (In_Tree               : Project_Tree_Ref;
6551
      Project               : Project_Processing_Data;
6552
      File_Name             : File_Name_Type;
6553
      Alternate_Languages   : out Language_List;
6554
      Language              : out Language_Ptr;
6555
      Display_Language_Name : out Name_Id;
6556
      Unit                  : out Name_Id;
6557
      Lang_Kind             : out Language_Kind;
6558
      Kind                  : out Source_Kind)
6559
   is
6560
      Filename : constant String := Get_Name_String (File_Name);
6561
      Config   : Language_Config;
6562
      Tmp_Lang : Language_Ptr;
6563
 
6564
      Header_File : Boolean := False;
6565
      --  True if we found at least one language for which the file is a header
6566
      --  In such a case, we search for all possible languages where this is
6567
      --  also a header (C and C++ for instance), since the file might be used
6568
      --  for several such languages.
6569
 
6570
      procedure Check_File_Based_Lang;
6571
      --  Does the naming scheme test for file-based languages. For those,
6572
      --  there is no Unit. Just check if the file name has the implementation
6573
      --  or, if it is specified, the template suffix of the language.
6574
      --
6575
      --  Returns True if the file belongs to the current language and we
6576
      --  should stop searching for matching languages. Not that a given header
6577
      --  file could belong to several languages (C and C++ for instance). Thus
6578
      --  if we found a header we'll check whether it matches other languages.
6579
 
6580
      ---------------------------
6581
      -- Check_File_Based_Lang --
6582
      ---------------------------
6583
 
6584
      procedure Check_File_Based_Lang is
6585
      begin
6586
         if not Header_File
6587
           and then Suffix_Matches (Filename, Config.Naming_Data.Body_Suffix)
6588
         then
6589
            Unit     := No_Name;
6590
            Kind     := Impl;
6591
            Language := Tmp_Lang;
6592
 
6593
            if Current_Verbosity = High then
6594
               Write_Str ("     implementation of language ");
6595
               Write_Line (Get_Name_String (Display_Language_Name));
6596
            end if;
6597
 
6598
         elsif Suffix_Matches (Filename, Config.Naming_Data.Spec_Suffix) then
6599
            if Current_Verbosity = High then
6600
               Write_Str ("     header of language ");
6601
               Write_Line (Get_Name_String (Display_Language_Name));
6602
            end if;
6603
 
6604
            if Header_File then
6605
               Alternate_Languages := new Language_List_Element'
6606
                 (Language => Language,
6607
                  Next     => Alternate_Languages);
6608
 
6609
            else
6610
               Header_File := True;
6611
               Kind        := Spec;
6612
               Unit        := No_Name;
6613
               Language    := Tmp_Lang;
6614
            end if;
6615
         end if;
6616
      end Check_File_Based_Lang;
6617
 
6618
   --  Start of processing for Check_File_Naming_Schemes
6619
 
6620
   begin
6621
      Language              := No_Language_Index;
6622
      Alternate_Languages   := null;
6623
      Display_Language_Name := No_Name;
6624
      Unit                  := No_Name;
6625
      Lang_Kind             := File_Based;
6626
      Kind                  := Spec;
6627
 
6628
      Tmp_Lang := Project.Project.Languages;
6629
      while Tmp_Lang /= No_Language_Index loop
6630
         if Current_Verbosity = High then
6631
            Write_Line
6632
              ("     Testing language "
6633
               & Get_Name_String (Tmp_Lang.Name)
6634
               & " Header_File=" & Header_File'Img);
6635
         end if;
6636
 
6637
         Display_Language_Name := Tmp_Lang.Display_Name;
6638
         Config := Tmp_Lang.Config;
6639
         Lang_Kind := Config.Kind;
6640
 
6641
         case Config.Kind is
6642
            when File_Based =>
6643
               Check_File_Based_Lang;
6644
               exit when Kind = Impl;
6645
 
6646
            when Unit_Based =>
6647
 
6648
               --  We know it belongs to a least a file_based language, no
6649
               --  need to check unit-based ones.
6650
 
6651
               if not Header_File then
6652
                  Compute_Unit_Name
6653
                    (File_Name       => File_Name,
6654
                     Naming          => Config.Naming_Data,
6655
                     Kind            => Kind,
6656
                     Unit            => Unit,
6657
                     Project         => Project,
6658
                     In_Tree         => In_Tree);
6659
 
6660
                  if Unit /= No_Name then
6661
                     Language    := Tmp_Lang;
6662
                     exit;
6663
                  end if;
6664
               end if;
6665
         end case;
6666
 
6667
         Tmp_Lang := Tmp_Lang.Next;
6668
      end loop;
6669
 
6670
      if Language = No_Language_Index
6671
        and then Current_Verbosity = High
6672
      then
6673
         Write_Line ("     not a source of any language");
6674
      end if;
6675
   end Check_File_Naming_Schemes;
6676
 
6677
   -------------------
6678
   -- Override_Kind --
6679
   -------------------
6680
 
6681
   procedure Override_Kind (Source : Source_Id; Kind : Source_Kind) is
6682
   begin
6683
      --  If the file was previously already associated with a unit, change it
6684
 
6685
      if Source.Unit /= null
6686
        and then Source.Kind in Spec_Or_Body
6687
        and then Source.Unit.File_Names (Source.Kind) /= null
6688
      then
6689
         --  If we had another file referencing the same unit (for instance it
6690
         --  was in an extended project), that source file is in fact invisible
6691
         --  from now on, and in particular doesn't belong to the same unit.
6692
 
6693
         if Source.Unit.File_Names (Source.Kind) /= Source then
6694
            Source.Unit.File_Names (Source.Kind).Unit := No_Unit_Index;
6695
         end if;
6696
 
6697
         Source.Unit.File_Names (Source.Kind) := null;
6698
      end if;
6699
 
6700
      Source.Kind := Kind;
6701
 
6702
      if Current_Verbosity = High
6703
        and then Source.File /= No_File
6704
      then
6705
         Write_Line ("Override kind for "
6706
                     & Get_Name_String (Source.File)
6707
                     & " kind=" & Source.Kind'Img);
6708
      end if;
6709
 
6710
      if Source.Kind in Spec_Or_Body and then Source.Unit /= null then
6711
         Source.Unit.File_Names (Source.Kind) := Source;
6712
      end if;
6713
   end Override_Kind;
6714
 
6715
   ----------------
6716
   -- Check_File --
6717
   ----------------
6718
 
6719
   procedure Check_File
6720
     (Project           : in out Project_Processing_Data;
6721
      Data              : in out Tree_Processing_Data;
6722
      Source_Dir_Rank   : Natural;
6723
      Path              : Path_Name_Type;
6724
      File_Name         : File_Name_Type;
6725
      Display_File_Name : File_Name_Type;
6726
      Locally_Removed   : Boolean;
6727
      For_All_Sources   : Boolean)
6728
   is
6729
      Canonical_Path : constant Path_Name_Type :=
6730
                         Path_Name_Type
6731
                           (Canonical_Case_File_Name (Name_Id (Path)));
6732
 
6733
      Name_Loc              : Name_Location :=
6734
                                Source_Names_Htable.Get
6735
                                  (Project.Source_Names, File_Name);
6736
      Check_Name            : Boolean := False;
6737
      Alternate_Languages   : Language_List;
6738
      Language              : Language_Ptr;
6739
      Source                : Source_Id;
6740
      Src_Ind               : Source_File_Index;
6741
      Unit                  : Name_Id;
6742
      Display_Language_Name : Name_Id;
6743
      Lang_Kind             : Language_Kind;
6744
      Kind                  : Source_Kind := Spec;
6745
 
6746
   begin
6747
      if Current_Verbosity = High then
6748
         Write_Line ("Checking file:");
6749
         Write_Str ("   Path = ");
6750
         Write_Line (Get_Name_String (Path));
6751
         Write_Str ("   Rank =");
6752
         Write_Line (Source_Dir_Rank'Img);
6753
      end if;
6754
 
6755
      if Name_Loc = No_Name_Location then
6756
         Check_Name := For_All_Sources;
6757
 
6758
      else
6759
         if Name_Loc.Found then
6760
 
6761
            --  Check if it is OK to have the same file name in several
6762
            --  source directories.
6763
 
6764
            if Source_Dir_Rank = Name_Loc.Source.Source_Dir_Rank then
6765
               Error_Msg_File_1 := File_Name;
6766
               Error_Msg
6767
                 (Data.Flags,
6768
                  "{ is found in several source directories",
6769
                  Name_Loc.Location, Project.Project);
6770
            end if;
6771
 
6772
         else
6773
            Name_Loc.Found := True;
6774
 
6775
            Source_Names_Htable.Set
6776
              (Project.Source_Names, File_Name, Name_Loc);
6777
 
6778
            if Name_Loc.Source = No_Source then
6779
               Check_Name := True;
6780
 
6781
            else
6782
               Name_Loc.Source.Path := (Canonical_Path, Path);
6783
 
6784
               Source_Paths_Htable.Set
6785
                 (Data.Tree.Source_Paths_HT,
6786
                  Canonical_Path,
6787
                  Name_Loc.Source);
6788
 
6789
               --  Check if this is a subunit
6790
 
6791
               if Name_Loc.Source.Unit /= No_Unit_Index
6792
                 and then Name_Loc.Source.Kind = Impl
6793
               then
6794
                  Src_Ind := Sinput.P.Load_Project_File
6795
                    (Get_Name_String (Canonical_Path));
6796
 
6797
                  if Sinput.P.Source_File_Is_Subunit (Src_Ind) then
6798
                     Override_Kind (Name_Loc.Source, Sep);
6799
                  end if;
6800
               end if;
6801
 
6802
               Files_Htable.Set
6803
                 (Data.File_To_Source, File_Name, Name_Loc.Source);
6804
            end if;
6805
         end if;
6806
      end if;
6807
 
6808
      if Check_Name then
6809
         Check_File_Naming_Schemes
6810
           (In_Tree               => Data.Tree,
6811
            Project               => Project,
6812
            File_Name             => File_Name,
6813
            Alternate_Languages   => Alternate_Languages,
6814
            Language              => Language,
6815
            Display_Language_Name => Display_Language_Name,
6816
            Unit                  => Unit,
6817
            Lang_Kind             => Lang_Kind,
6818
            Kind                  => Kind);
6819
 
6820
         if Language = No_Language_Index then
6821
 
6822
            --  A file name in a list must be a source of a language
6823
 
6824
            if Data.Flags.Error_On_Unknown_Language
6825
              and then Name_Loc.Found
6826
            then
6827
               Error_Msg_File_1 := File_Name;
6828
               Error_Msg
6829
                 (Data.Flags,
6830
                  "language unknown for {",
6831
                  Name_Loc.Location, Project.Project);
6832
            end if;
6833
 
6834
         else
6835
            Add_Source
6836
              (Id                  => Source,
6837
               Project             => Project.Project,
6838
               Source_Dir_Rank     => Source_Dir_Rank,
6839
               Lang_Id             => Language,
6840
               Kind                => Kind,
6841
               Data                => Data,
6842
               Alternate_Languages => Alternate_Languages,
6843
               File_Name           => File_Name,
6844
               Display_File        => Display_File_Name,
6845
               Unit                => Unit,
6846
               Locally_Removed     => Locally_Removed,
6847
               Path                => (Canonical_Path, Path));
6848
 
6849
            --  If it is a source specified in a list, update the entry in
6850
            --  the Source_Names table.
6851
 
6852
            if Name_Loc.Found and then Name_Loc.Source = No_Source then
6853
               Name_Loc.Source := Source;
6854
               Source_Names_Htable.Set
6855
                 (Project.Source_Names, File_Name, Name_Loc);
6856
            end if;
6857
         end if;
6858
      end if;
6859
   end Check_File;
6860
 
6861
   ------------------------
6862
   -- Search_Directories --
6863
   ------------------------
6864
 
6865
   procedure Search_Directories
6866
     (Project         : in out Project_Processing_Data;
6867
      Data            : in out Tree_Processing_Data;
6868
      For_All_Sources : Boolean)
6869
   is
6870
      Source_Dir        : String_List_Id;
6871
      Element           : String_Element;
6872
      Src_Dir_Rank      : Number_List_Index;
6873
      Num_Nod           : Number_Node;
6874
      Dir               : Dir_Type;
6875
      Name              : String (1 .. 1_000);
6876
      Last              : Natural;
6877
      File_Name         : File_Name_Type;
6878
      Display_File_Name : File_Name_Type;
6879
 
6880
   begin
6881
      if Current_Verbosity = High then
6882
         Write_Line ("Looking for sources:");
6883
      end if;
6884
 
6885
      --  Loop through subdirectories
6886
 
6887
      Source_Dir := Project.Project.Source_Dirs;
6888
      Src_Dir_Rank := Project.Project.Source_Dir_Ranks;
6889
      while Source_Dir /= Nil_String loop
6890
         begin
6891
            Num_Nod := Data.Tree.Number_Lists.Table (Src_Dir_Rank);
6892
            Element := Data.Tree.String_Elements.Table (Source_Dir);
6893
 
6894
            if Element.Value /= No_Name then
6895
               Get_Name_String (Element.Display_Value);
6896
 
6897
               if Current_Verbosity = High then
6898
                  Write_Str ("Directory: ");
6899
                  Write_Str (Name_Buffer (1 .. Name_Len));
6900
                  Write_Line (Num_Nod.Number'Img);
6901
               end if;
6902
 
6903
               declare
6904
                  Source_Directory : constant String :=
6905
                                       Name_Buffer (1 .. Name_Len) &
6906
                                         Directory_Separator;
6907
 
6908
                  Dir_Last : constant Natural :=
6909
                                       Compute_Directory_Last
6910
                                         (Source_Directory);
6911
 
6912
               begin
6913
                  if Current_Verbosity = High then
6914
                     Write_Attr ("Source_Dir", Source_Directory);
6915
                  end if;
6916
 
6917
                  --  We look to every entry in the source directory
6918
 
6919
                  Open (Dir, Source_Directory);
6920
 
6921
                  loop
6922
                     Read (Dir, Name, Last);
6923
 
6924
                     exit when Last = 0;
6925
 
6926
                     --  In fast project loading mode (without -eL), the user
6927
                     --  guarantees that no directory has a name which is a
6928
                     --  valid source name, so we can avoid doing a system call
6929
                     --  here. This provides a very significant speed up on
6930
                     --  slow file systems (remote files for instance).
6931
 
6932
                     if not Opt.Follow_Links_For_Files
6933
                       or else Is_Regular_File
6934
                                 (Source_Directory & Name (1 .. Last))
6935
                     then
6936
                        if Current_Verbosity = High then
6937
                           Write_Str  ("   Checking ");
6938
                           Write_Line (Name (1 .. Last));
6939
                        end if;
6940
 
6941
                        Name_Len := Last;
6942
                        Name_Buffer (1 .. Name_Len) := Name (1 .. Last);
6943
                        Display_File_Name := Name_Find;
6944
 
6945
                        if Osint.File_Names_Case_Sensitive then
6946
                           File_Name := Display_File_Name;
6947
                        else
6948
                           Canonical_Case_File_Name
6949
                             (Name_Buffer (1 .. Name_Len));
6950
                           File_Name := Name_Find;
6951
                        end if;
6952
 
6953
                        declare
6954
                           Path_Name : constant String :=
6955
                                         Normalize_Pathname
6956
                                           (Name (1 .. Last),
6957
                                            Directory       =>
6958
                                              Source_Directory
6959
                                                (Source_Directory'First ..
6960
                                                 Dir_Last),
6961
                                            Resolve_Links   =>
6962
                                              Opt.Follow_Links_For_Files,
6963
                                            Case_Sensitive => True);
6964
                           --  Case_Sensitive set True (no folding)
6965
 
6966
                           Path : Path_Name_Type;
6967
                           FF   : File_Found := Excluded_Sources_Htable.Get
6968
                                                 (Project.Excluded, File_Name);
6969
                           To_Remove : Boolean := False;
6970
 
6971
                        begin
6972
                           Name_Len := Path_Name'Length;
6973
                           Name_Buffer (1 .. Name_Len) := Path_Name;
6974
                           Path := Name_Find;
6975
 
6976
                           if FF /= No_File_Found then
6977
                              if not FF.Found then
6978
                                 FF.Found := True;
6979
                                 Excluded_Sources_Htable.Set
6980
                                   (Project.Excluded, File_Name, FF);
6981
 
6982
                                 if Current_Verbosity = High then
6983
                                    Write_Str ("     excluded source """);
6984
                                    Write_Str (Get_Name_String (File_Name));
6985
                                    Write_Line ("""");
6986
                                 end if;
6987
 
6988
                                 --  Will mark the file as removed, but we
6989
                                 --  still need to add it to the list: if we
6990
                                 --  don't, the file will not appear in the
6991
                                 --  mapping file and will cause the compiler
6992
                                 --  to fail.
6993
 
6994
                                 To_Remove := True;
6995
                              end if;
6996
                           end if;
6997
 
6998
                           Check_File
6999
                             (Project           => Project,
7000
                              Source_Dir_Rank   => Num_Nod.Number,
7001
                              Data              => Data,
7002
                              Path              => Path,
7003
                              File_Name         => File_Name,
7004
                              Locally_Removed   => To_Remove,
7005
                              Display_File_Name => Display_File_Name,
7006
                              For_All_Sources   => For_All_Sources);
7007
                        end;
7008
                     end if;
7009
                  end loop;
7010
 
7011
                  Close (Dir);
7012
               end;
7013
            end if;
7014
 
7015
         exception
7016
            when Directory_Error =>
7017
               null;
7018
         end;
7019
 
7020
         Source_Dir := Element.Next;
7021
         Src_Dir_Rank := Num_Nod.Next;
7022
      end loop;
7023
 
7024
      if Current_Verbosity = High then
7025
         Write_Line ("end Looking for sources.");
7026
      end if;
7027
   end Search_Directories;
7028
 
7029
   ----------------------------
7030
   -- Load_Naming_Exceptions --
7031
   ----------------------------
7032
 
7033
   procedure Load_Naming_Exceptions
7034
     (Project : in out Project_Processing_Data;
7035
      Data    : in out Tree_Processing_Data)
7036
   is
7037
      Source : Source_Id;
7038
      Iter   : Source_Iterator;
7039
 
7040
   begin
7041
      Iter := For_Each_Source (Data.Tree, Project.Project);
7042
      loop
7043
         Source := Prj.Element (Iter);
7044
         exit when Source = No_Source;
7045
 
7046
         --  An excluded file cannot also be an exception file name
7047
 
7048
         if Excluded_Sources_Htable.Get (Project.Excluded, Source.File) /=
7049
                                                                 No_File_Found
7050
         then
7051
            Error_Msg_File_1 := Source.File;
7052
            Error_Msg
7053
              (Data.Flags,
7054
               "{ cannot be both excluded and an exception file name",
7055
               No_Location, Project.Project);
7056
         end if;
7057
 
7058
         if Current_Verbosity = High then
7059
            Write_Str ("Naming exception: Putting source file ");
7060
            Write_Str (Get_Name_String (Source.File));
7061
            Write_Line (" in Source_Names");
7062
         end if;
7063
 
7064
         Source_Names_Htable.Set
7065
           (Project.Source_Names,
7066
            K => Source.File,
7067
            E => Name_Location'
7068
                  (Name     => Source.File,
7069
                   Location => No_Location,
7070
                   Source   => Source,
7071
                   Found    => False));
7072
 
7073
         --  If this is an Ada exception, record in table Unit_Exceptions
7074
 
7075
         if Source.Unit /= No_Unit_Index then
7076
            declare
7077
               Unit_Except : Unit_Exception :=
7078
                 Unit_Exceptions_Htable.Get
7079
                   (Project.Unit_Exceptions, Source.Unit.Name);
7080
 
7081
            begin
7082
               Unit_Except.Name := Source.Unit.Name;
7083
 
7084
               if Source.Kind = Spec then
7085
                  Unit_Except.Spec := Source.File;
7086
               else
7087
                  Unit_Except.Impl := Source.File;
7088
               end if;
7089
 
7090
               Unit_Exceptions_Htable.Set
7091
                 (Project.Unit_Exceptions, Source.Unit.Name, Unit_Except);
7092
            end;
7093
         end if;
7094
 
7095
         Next (Iter);
7096
      end loop;
7097
   end Load_Naming_Exceptions;
7098
 
7099
   ----------------------
7100
   -- Look_For_Sources --
7101
   ----------------------
7102
 
7103
   procedure Look_For_Sources
7104
     (Project : in out Project_Processing_Data;
7105
      Data    : in out Tree_Processing_Data)
7106
   is
7107
      Object_Files : Object_File_Names_Htable.Instance;
7108
      Iter : Source_Iterator;
7109
      Src  : Source_Id;
7110
 
7111
      procedure Check_Object (Src : Source_Id);
7112
      --  Check if object file name of Src is already used in the project tree,
7113
      --  and report an error if so.
7114
 
7115
      procedure Check_Object_Files;
7116
      --  Check that no two sources of this project have the same object file
7117
 
7118
      procedure Mark_Excluded_Sources;
7119
      --  Mark as such the sources that are declared as excluded
7120
 
7121
      ------------------
7122
      -- Check_Object --
7123
      ------------------
7124
 
7125
      procedure Check_Object (Src : Source_Id) is
7126
         Source : Source_Id;
7127
 
7128
      begin
7129
         Source := Object_File_Names_Htable.Get (Object_Files, Src.Object);
7130
 
7131
         --  We cannot just check on "Source /= Src", since we might have
7132
         --  two different entries for the same file (and since that's
7133
         --  the same file it is expected that it has the same object)
7134
 
7135
         if Source /= No_Source
7136
           and then Source.Path /= Src.Path
7137
         then
7138
            Error_Msg_File_1 := Src.File;
7139
            Error_Msg_File_2 := Source.File;
7140
            Error_Msg
7141
              (Data.Flags,
7142
               "{ and { have the same object file name",
7143
               No_Location, Project.Project);
7144
 
7145
         else
7146
            Object_File_Names_Htable.Set (Object_Files, Src.Object, Src);
7147
         end if;
7148
      end Check_Object;
7149
 
7150
      ---------------------------
7151
      -- Mark_Excluded_Sources --
7152
      ---------------------------
7153
 
7154
      procedure Mark_Excluded_Sources is
7155
         Source   : Source_Id := No_Source;
7156
         Excluded : File_Found;
7157
         Proj     : Project_Id;
7158
 
7159
      begin
7160
         --  Minor optimization: if there are no excluded files, no need to
7161
         --  traverse the list of sources. We cannot however also check whether
7162
         --  the existing exceptions have ".Found" set to True (indicating we
7163
         --  found them before) because we need to do some final processing on
7164
         --  them in any case.
7165
 
7166
         if Excluded_Sources_Htable.Get_First (Project.Excluded) /=
7167
                                                             No_File_Found
7168
         then
7169
            Proj := Project.Project;
7170
            while Proj /= No_Project loop
7171
               Iter := For_Each_Source (Data.Tree, Proj);
7172
               while Prj.Element (Iter) /= No_Source loop
7173
                  Source   := Prj.Element (Iter);
7174
                  Excluded := Excluded_Sources_Htable.Get
7175
                    (Project.Excluded, Source.File);
7176
 
7177
                  if Excluded /= No_File_Found then
7178
                     Source.Locally_Removed := True;
7179
                     Source.In_Interfaces   := False;
7180
 
7181
                     if Current_Verbosity = High then
7182
                        Write_Str ("Removing file ");
7183
                        Write_Line
7184
                          (Get_Name_String (Excluded.File)
7185
                           & " " & Get_Name_String (Source.Project.Name));
7186
                     end if;
7187
 
7188
                     Excluded_Sources_Htable.Remove
7189
                       (Project.Excluded, Source.File);
7190
                  end if;
7191
 
7192
                  Next (Iter);
7193
               end loop;
7194
 
7195
               Proj := Proj.Extends;
7196
            end loop;
7197
         end if;
7198
 
7199
         --  If we have any excluded element left, that means we did not find
7200
         --  the source file
7201
 
7202
         Excluded := Excluded_Sources_Htable.Get_First (Project.Excluded);
7203
         while Excluded /= No_File_Found loop
7204
            if not Excluded.Found then
7205
 
7206
               --  Check if the file belongs to another imported project to
7207
               --  provide a better error message.
7208
 
7209
               Src := Find_Source
7210
                 (In_Tree          => Data.Tree,
7211
                  Project          => Project.Project,
7212
                  In_Imported_Only => True,
7213
                  Base_Name        => Excluded.File);
7214
 
7215
               Err_Vars.Error_Msg_File_1 := Excluded.File;
7216
 
7217
               if Src = No_Source then
7218
                  Error_Msg
7219
                    (Data.Flags,
7220
                     "unknown file {", Excluded.Location, Project.Project);
7221
               else
7222
                  Error_Msg
7223
                    (Data.Flags,
7224
                     "cannot remove a source from an imported project: {",
7225
                     Excluded.Location, Project.Project);
7226
               end if;
7227
            end if;
7228
 
7229
            Excluded := Excluded_Sources_Htable.Get_Next (Project.Excluded);
7230
         end loop;
7231
      end Mark_Excluded_Sources;
7232
 
7233
      ------------------------
7234
      -- Check_Object_Files --
7235
      ------------------------
7236
 
7237
      procedure Check_Object_Files is
7238
         Iter    : Source_Iterator;
7239
         Src_Id  : Source_Id;
7240
         Src_Ind : Source_File_Index;
7241
 
7242
      begin
7243
         Iter := For_Each_Source (Data.Tree);
7244
         loop
7245
            Src_Id := Prj.Element (Iter);
7246
            exit when Src_Id = No_Source;
7247
 
7248
            if Is_Compilable (Src_Id)
7249
              and then Src_Id.Language.Config.Object_Generated
7250
              and then Is_Extending (Project.Project, Src_Id.Project)
7251
            then
7252
               if Src_Id.Unit = No_Unit_Index then
7253
                  if Src_Id.Kind = Impl then
7254
                     Check_Object (Src_Id);
7255
                  end if;
7256
 
7257
               else
7258
                  case Src_Id.Kind is
7259
                     when Spec =>
7260
                        if Other_Part (Src_Id) = No_Source then
7261
                           Check_Object (Src_Id);
7262
                        end if;
7263
 
7264
                     when Sep =>
7265
                        null;
7266
 
7267
                     when Impl =>
7268
                        if Other_Part (Src_Id) /= No_Source then
7269
                           Check_Object (Src_Id);
7270
 
7271
                        else
7272
                           --  Check if it is a subunit
7273
 
7274
                           Src_Ind :=
7275
                             Sinput.P.Load_Project_File
7276
                               (Get_Name_String (Src_Id.Path.Name));
7277
 
7278
                           if Sinput.P.Source_File_Is_Subunit (Src_Ind) then
7279
                              Override_Kind (Src_Id, Sep);
7280
                           else
7281
                              Check_Object (Src_Id);
7282
                           end if;
7283
                        end if;
7284
                  end case;
7285
               end if;
7286
            end if;
7287
 
7288
            Next (Iter);
7289
         end loop;
7290
      end Check_Object_Files;
7291
 
7292
   --  Start of processing for Look_For_Sources
7293
 
7294
   begin
7295
      Find_Excluded_Sources (Project, Data);
7296
 
7297
      if Project.Project.Languages /= No_Language_Index then
7298
         Load_Naming_Exceptions (Project, Data);
7299
         Find_Sources (Project, Data);
7300
         Mark_Excluded_Sources;
7301
         Check_Object_Files;
7302
      end if;
7303
 
7304
      Object_File_Names_Htable.Reset (Object_Files);
7305
   end Look_For_Sources;
7306
 
7307
   ------------------
7308
   -- Path_Name_Of --
7309
   ------------------
7310
 
7311
   function Path_Name_Of
7312
     (File_Name : File_Name_Type;
7313
      Directory : Path_Name_Type) return String
7314
   is
7315
      Result        : String_Access;
7316
      The_Directory : constant String := Get_Name_String (Directory);
7317
 
7318
   begin
7319
      Get_Name_String (File_Name);
7320
      Result :=
7321
        Locate_Regular_File
7322
          (File_Name => Name_Buffer (1 .. Name_Len),
7323
           Path      => The_Directory);
7324
 
7325
      if Result = null then
7326
         return "";
7327
      else
7328
         declare
7329
            R : String := Result.all;
7330
         begin
7331
            Free (Result);
7332
            Canonical_Case_File_Name (R);
7333
            return R;
7334
         end;
7335
      end if;
7336
   end Path_Name_Of;
7337
 
7338
   -------------------
7339
   -- Remove_Source --
7340
   -------------------
7341
 
7342
   procedure Remove_Source
7343
     (Id          : Source_Id;
7344
      Replaced_By : Source_Id)
7345
   is
7346
      Source : Source_Id;
7347
 
7348
   begin
7349
      if Current_Verbosity = High then
7350
         Write_Str ("Removing source ");
7351
         Write_Str (Get_Name_String (Id.File));
7352
 
7353
         if Id.Index /= 0 then
7354
            Write_Str (" at" & Id.Index'Img);
7355
         end if;
7356
 
7357
         Write_Eol;
7358
      end if;
7359
 
7360
      if Replaced_By /= No_Source then
7361
         Id.Replaced_By := Replaced_By;
7362
         Replaced_By.Declared_In_Interfaces := Id.Declared_In_Interfaces;
7363
      end if;
7364
 
7365
      Id.In_Interfaces := False;
7366
      Id.Locally_Removed := True;
7367
 
7368
      --  ??? Should we remove the source from the unit ? The file is not used,
7369
      --  so probably should not be referenced from the unit. On the other hand
7370
      --  it might give useful additional info
7371
      --        if Id.Unit /= null then
7372
      --           Id.Unit.File_Names (Id.Kind) := null;
7373
      --        end if;
7374
 
7375
      Source := Id.Language.First_Source;
7376
 
7377
      if Source = Id then
7378
         Id.Language.First_Source := Id.Next_In_Lang;
7379
 
7380
      else
7381
         while Source.Next_In_Lang /= Id loop
7382
            Source := Source.Next_In_Lang;
7383
         end loop;
7384
 
7385
         Source.Next_In_Lang := Id.Next_In_Lang;
7386
      end if;
7387
   end Remove_Source;
7388
 
7389
   -----------------------
7390
   -- Report_No_Sources --
7391
   -----------------------
7392
 
7393
   procedure Report_No_Sources
7394
     (Project      : Project_Id;
7395
      Lang_Name    : String;
7396
      Data         : Tree_Processing_Data;
7397
      Location     : Source_Ptr;
7398
      Continuation : Boolean := False)
7399
   is
7400
   begin
7401
      case Data.Flags.When_No_Sources is
7402
         when Silent =>
7403
            null;
7404
 
7405
         when Warning | Error =>
7406
            declare
7407
               Msg : constant String :=
7408
                       "<there are no " &
7409
                       Lang_Name &
7410
                       " sources in this project";
7411
 
7412
            begin
7413
               Error_Msg_Warn := Data.Flags.When_No_Sources = Warning;
7414
 
7415
               if Continuation then
7416
                  Error_Msg (Data.Flags, "\" & Msg, Location, Project);
7417
               else
7418
                  Error_Msg (Data.Flags, Msg, Location, Project);
7419
               end if;
7420
            end;
7421
      end case;
7422
   end Report_No_Sources;
7423
 
7424
   ----------------------
7425
   -- Show_Source_Dirs --
7426
   ----------------------
7427
 
7428
   procedure Show_Source_Dirs
7429
     (Project : Project_Id;
7430
      In_Tree : Project_Tree_Ref)
7431
   is
7432
      Current : String_List_Id;
7433
      Element : String_Element;
7434
 
7435
   begin
7436
      Write_Line ("Source_Dirs:");
7437
 
7438
      Current := Project.Source_Dirs;
7439
      while Current /= Nil_String loop
7440
         Element := In_Tree.String_Elements.Table (Current);
7441
         Write_Str  ("   ");
7442
         Write_Line (Get_Name_String (Element.Value));
7443
         Current := Element.Next;
7444
      end loop;
7445
 
7446
      Write_Line ("end Source_Dirs.");
7447
   end Show_Source_Dirs;
7448
 
7449
   ---------------------------
7450
   -- Process_Naming_Scheme --
7451
   ---------------------------
7452
 
7453
   procedure Process_Naming_Scheme
7454
     (Tree         : Project_Tree_Ref;
7455
      Root_Project : Project_Id;
7456
      Flags        : Processing_Flags)
7457
   is
7458
      procedure Recursive_Check
7459
        (Project : Project_Id;
7460
         Data    : in out Tree_Processing_Data);
7461
      --  Check_Naming_Scheme for the project
7462
 
7463
      ---------------------
7464
      -- Recursive_Check --
7465
      ---------------------
7466
 
7467
      procedure Recursive_Check
7468
        (Project : Project_Id;
7469
         Data    : in out Tree_Processing_Data)
7470
      is
7471
      begin
7472
         if Verbose_Mode then
7473
            Write_Str ("Processing_Naming_Scheme for project """);
7474
            Write_Str (Get_Name_String (Project.Name));
7475
            Write_Line ("""");
7476
         end if;
7477
 
7478
         Prj.Nmsc.Check (Project, Data);
7479
      end Recursive_Check;
7480
 
7481
      procedure Check_All_Projects is new
7482
        For_Every_Project_Imported (Tree_Processing_Data, Recursive_Check);
7483
 
7484
      Data : Tree_Processing_Data;
7485
 
7486
   --  Start of processing for Process_Naming_Scheme
7487
   begin
7488
      Initialize (Data, Tree => Tree, Flags => Flags);
7489
      Check_All_Projects (Root_Project, Data, Imported_First => True);
7490
      Free (Data);
7491
   end Process_Naming_Scheme;
7492
 
7493
end Prj.Nmsc;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.