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

Subversion Repositories openrisc_2011-10-31

[/] [openrisc/] [tags/] [gnu-src/] [gcc-4.5.1/] [gcc-4.5.1-or32-1.0rc2/] [gcc/] [ada/] [prj-part.adb] - Blame information for rev 384

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 281 jeremybenn
------------------------------------------------------------------------------
2
--                                                                          --
3
--                         GNAT COMPILER COMPONENTS                         --
4
--                                                                          --
5
--                             P R J . P A R T                              --
6
--                                                                          --
7
--                                 B o d y                                  --
8
--                                                                          --
9
--          Copyright (C) 2001-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 Err_Vars; use Err_Vars;
27
with Opt;      use Opt;
28
with Osint;    use Osint;
29
with Output;   use Output;
30
with Prj.Com;  use Prj.Com;
31
with Prj.Dect;
32
with Prj.Err;  use Prj.Err;
33
with Prj.Ext;  use Prj.Ext;
34
with Sinput;   use Sinput;
35
with Sinput.P; use Sinput.P;
36
with Snames;
37
with Table;
38
 
39
with Ada.Characters.Handling;    use Ada.Characters.Handling;
40
with Ada.Exceptions;             use Ada.Exceptions;
41
 
42
with GNAT.Directory_Operations; use GNAT.Directory_Operations;
43
 
44
with System.HTable;              use System.HTable;
45
 
46
package body Prj.Part is
47
 
48
   Buffer      : String_Access;
49
   Buffer_Last : Natural := 0;
50
 
51
   Dir_Sep : Character renames GNAT.OS_Lib.Directory_Separator;
52
 
53
   ------------------------------------
54
   -- Local Packages and Subprograms --
55
   ------------------------------------
56
 
57
   type With_Id is new Nat;
58
   No_With : constant With_Id := 0;
59
 
60
   type With_Record is record
61
      Path         : Path_Name_Type;
62
      Location     : Source_Ptr;
63
      Limited_With : Boolean;
64
      Node         : Project_Node_Id;
65
      Next         : With_Id;
66
   end record;
67
   --  Information about an imported project, to be put in table Withs below
68
 
69
   package Withs is new Table.Table
70
     (Table_Component_Type => With_Record,
71
      Table_Index_Type     => With_Id,
72
      Table_Low_Bound      => 1,
73
      Table_Initial        => 10,
74
      Table_Increment      => 100,
75
      Table_Name           => "Prj.Part.Withs");
76
   --  Table used to store temporarily paths and locations of imported
77
   --  projects. These imported projects will be effectively parsed later: just
78
   --  before parsing the current project for the non limited withed projects,
79
   --  after getting its name; after complete parsing of the current project
80
   --  for the limited withed projects.
81
 
82
   type Names_And_Id is record
83
      Path_Name           : Path_Name_Type;
84
      Canonical_Path_Name : Path_Name_Type;
85
      Id                  : Project_Node_Id;
86
      Limited_With        : Boolean;
87
   end record;
88
 
89
   package Project_Stack is new Table.Table
90
     (Table_Component_Type => Names_And_Id,
91
      Table_Index_Type     => Nat,
92
      Table_Low_Bound      => 1,
93
      Table_Initial        => 10,
94
      Table_Increment      => 100,
95
      Table_Name           => "Prj.Part.Project_Stack");
96
   --  This table is used to detect circular dependencies
97
   --  for imported and extended projects and to get the project ids of
98
   --  limited imported projects when there is a circularity with at least
99
   --  one limited imported project file.
100
 
101
   package Virtual_Hash is new System.HTable.Simple_HTable
102
     (Header_Num => Header_Num,
103
      Element    => Project_Node_Id,
104
      No_Element => Empty_Node,
105
      Key        => Project_Node_Id,
106
      Hash       => Prj.Tree.Hash,
107
      Equal      => "=");
108
   --  Hash table to store the node id of the project for which a virtual
109
   --  extending project need to be created.
110
 
111
   package Processed_Hash is new System.HTable.Simple_HTable
112
     (Header_Num => Header_Num,
113
      Element    => Boolean,
114
      No_Element => False,
115
      Key        => Project_Node_Id,
116
      Hash       => Prj.Tree.Hash,
117
      Equal      => "=");
118
   --  Hash table to store the project process when looking for project that
119
   --  need to have a virtual extending project, to avoid processing the same
120
   --  project twice.
121
 
122
   package Projects_Paths is new System.HTable.Simple_HTable
123
     (Header_Num => Header_Num,
124
      Element    => Path_Name_Type,
125
      No_Element => No_Path,
126
      Key        => Name_Id,
127
      Hash       => Hash,
128
      Equal      => "=");
129
   --  Hash table to cache project path to avoid looking for them on the path
130
 
131
   procedure Create_Virtual_Extending_Project
132
     (For_Project  : Project_Node_Id;
133
      Main_Project : Project_Node_Id;
134
      In_Tree      : Project_Node_Tree_Ref);
135
   --  Create a virtual extending project of For_Project. Main_Project is
136
   --  the extending all project.
137
   --
138
   --  The String_Value_Of is not set for the automatically added with
139
   --  clause and keeps the default value of No_Name. This enables Prj.PP
140
   --  to skip these automatically added with clauses to be processed.
141
 
142
   procedure Look_For_Virtual_Projects_For
143
     (Proj                : Project_Node_Id;
144
      In_Tree             : Project_Node_Tree_Ref;
145
      Potentially_Virtual : Boolean);
146
   --  Look for projects that need to have a virtual extending project.
147
   --  This procedure is recursive. If called with Potentially_Virtual set to
148
   --  True, then Proj may need an virtual extending project; otherwise it
149
   --  does not (because it is already extended), but other projects that it
150
   --  imports may need to be virtually extended.
151
 
152
   type Extension_Origin is (None, Extending_Simple, Extending_All);
153
   --  Type of parameter From_Extended for procedures Parse_Single_Project and
154
   --  Post_Parse_Context_Clause. Extending_All means that we are parsing the
155
   --  tree rooted at an extending all project.
156
 
157
   procedure Parse_Single_Project
158
     (In_Tree           : Project_Node_Tree_Ref;
159
      Project           : out Project_Node_Id;
160
      Extends_All       : out Boolean;
161
      Path_Name         : String;
162
      Extended          : Boolean;
163
      From_Extended     : Extension_Origin;
164
      In_Limited        : Boolean;
165
      Packages_To_Check : String_List_Access;
166
      Depth             : Natural;
167
      Current_Dir       : String;
168
      Is_Config_File    : Boolean;
169
      Flags             : Processing_Flags);
170
   --  Parse a project file. This is a recursive procedure: it calls itself for
171
   --  imported and extended projects. When From_Extended is not None, if the
172
   --  project has already been parsed and is an extended project A, return the
173
   --  ultimate (not extended) project that extends A. When In_Limited is True,
174
   --  the importing path includes at least one "limited with". When parsing
175
   --  configuration projects, do not allow a depth > 1.
176
   --
177
   --  Is_Config_File should be set to True if the project represents a config
178
   --  file (.cgpr) since some specific checks apply.
179
 
180
   procedure Pre_Parse_Context_Clause
181
     (In_Tree        : Project_Node_Tree_Ref;
182
      Context_Clause : out With_Id;
183
      Is_Config_File : Boolean;
184
      Flags          : Processing_Flags);
185
   --  Parse the context clause of a project. Store the paths and locations of
186
   --  the imported projects in table Withs. Does nothing if there is no
187
   --  context clause (if the current token is not "with" or "limited" followed
188
   --  by "with").
189
   --  Is_Config_File should be set to True if the project represents a config
190
   --  file (.cgpr) since some specific checks apply.
191
 
192
   procedure Post_Parse_Context_Clause
193
     (Context_Clause    : With_Id;
194
      In_Tree           : Project_Node_Tree_Ref;
195
      Limited_Withs     : Boolean;
196
      Imported_Projects : in out Project_Node_Id;
197
      Project_Directory : Path_Name_Type;
198
      From_Extended     : Extension_Origin;
199
      In_Limited        : Boolean;
200
      Packages_To_Check : String_List_Access;
201
      Depth             : Natural;
202
      Current_Dir       : String;
203
      Is_Config_File    : Boolean;
204
      Flags             : Processing_Flags);
205
   --  Parse the imported projects that have been stored in table Withs, if
206
   --  any. From_Extended is used for the call to Parse_Single_Project below.
207
   --  When In_Limited is True, the importing path includes at least one
208
   --  "limited with". When Limited_Withs is False, only non limited withed
209
   --  projects are parsed. When Limited_Withs is True, only limited withed
210
   --  projects are parsed.
211
   --  Is_Config_File should be set to True if the project represents a config
212
   --  file (.cgpr) since some specific checks apply.
213
 
214
   function Project_Path_Name_Of
215
     (In_Tree           : Project_Node_Tree_Ref;
216
      Project_File_Name : String;
217
      Directory         : String) return String;
218
   --  Returns the path name of a project file. Returns an empty string
219
   --  if project file cannot be found.
220
 
221
   function Project_Name_From
222
     (Path_Name      : String;
223
      Is_Config_File : Boolean) return Name_Id;
224
   --  Returns the name of the project that corresponds to its path name.
225
   --  Returns No_Name if the path name is invalid, because the corresponding
226
   --  project name does not have the syntax of an ada identifier.
227
 
228
   --------------------------------------
229
   -- Create_Virtual_Extending_Project --
230
   --------------------------------------
231
 
232
   procedure Create_Virtual_Extending_Project
233
     (For_Project  : Project_Node_Id;
234
      Main_Project : Project_Node_Id;
235
      In_Tree      : Project_Node_Tree_Ref)
236
   is
237
 
238
      Virtual_Name : constant String :=
239
                       Virtual_Prefix &
240
                         Get_Name_String (Name_Of (For_Project, In_Tree));
241
      --  The name of the virtual extending project
242
 
243
      Virtual_Name_Id : Name_Id;
244
      --  Virtual extending project name id
245
 
246
      Virtual_Path_Id : Path_Name_Type;
247
      --  Fake path name of the virtual extending project. The directory is
248
      --  the same directory as the extending all project.
249
 
250
      --  The source of the virtual extending project is something like:
251
 
252
      --  project V$<project name> extends <project path> is
253
 
254
      --     for Source_Dirs use ();
255
 
256
      --  end V$<project name>;
257
 
258
      --  The project directory cannot be specified during parsing; it will be
259
      --  put directly in the virtual extending project data during processing.
260
 
261
      --  Nodes that made up the virtual extending project
262
 
263
      Virtual_Project         : Project_Node_Id;
264
      With_Clause             : constant Project_Node_Id :=
265
                                  Default_Project_Node
266
                                    (In_Tree, N_With_Clause);
267
      Project_Declaration     : Project_Node_Id;
268
      Source_Dirs_Declaration : constant Project_Node_Id :=
269
                                  Default_Project_Node
270
                                    (In_Tree, N_Declarative_Item);
271
      Source_Dirs_Attribute   : constant Project_Node_Id :=
272
                                  Default_Project_Node
273
                                    (In_Tree, N_Attribute_Declaration, List);
274
      Source_Dirs_Expression  : constant Project_Node_Id :=
275
                                  Default_Project_Node
276
                                    (In_Tree, N_Expression, List);
277
      Source_Dirs_Term        : constant Project_Node_Id :=
278
                                  Default_Project_Node
279
                                    (In_Tree, N_Term, List);
280
      Source_Dirs_List        : constant Project_Node_Id :=
281
                                  Default_Project_Node
282
                                    (In_Tree, N_Literal_String_List, List);
283
 
284
   begin
285
      --  Get the virtual path name
286
 
287
      Get_Name_String (Path_Name_Of (Main_Project, In_Tree));
288
 
289
      while Name_Len > 0
290
        and then Name_Buffer (Name_Len) /= Directory_Separator
291
        and then Name_Buffer (Name_Len) /= '/'
292
      loop
293
         Name_Len := Name_Len - 1;
294
      end loop;
295
 
296
      Name_Buffer (Name_Len + 1 .. Name_Len + Virtual_Name'Length) :=
297
        Virtual_Name;
298
      Name_Len := Name_Len + Virtual_Name'Length;
299
      Virtual_Path_Id := Name_Find;
300
 
301
      --  Get the virtual name id
302
 
303
      Name_Len := Virtual_Name'Length;
304
      Name_Buffer (1 .. Name_Len) := Virtual_Name;
305
      Virtual_Name_Id := Name_Find;
306
 
307
      Virtual_Project := Create_Project
308
        (In_Tree        => In_Tree,
309
         Name           => Virtual_Name_Id,
310
         Full_Path      => Virtual_Path_Id,
311
         Is_Config_File => False);
312
 
313
      Project_Declaration := Project_Declaration_Of (Virtual_Project, In_Tree);
314
 
315
      --  With clause
316
 
317
      Set_Name_Of (With_Clause, In_Tree, Virtual_Name_Id);
318
      Set_Path_Name_Of (With_Clause, In_Tree, Virtual_Path_Id);
319
      Set_Project_Node_Of (With_Clause, In_Tree, Virtual_Project);
320
      Set_Next_With_Clause_Of
321
        (With_Clause, In_Tree, First_With_Clause_Of (Main_Project, In_Tree));
322
      Set_First_With_Clause_Of (Main_Project, In_Tree, With_Clause);
323
 
324
      --  Virtual project node
325
 
326
      Set_Location_Of
327
        (Virtual_Project, In_Tree, Location_Of (Main_Project, In_Tree));
328
      Set_Extended_Project_Path_Of
329
        (Virtual_Project, In_Tree, Path_Name_Of (For_Project, In_Tree));
330
 
331
      --  Project declaration
332
 
333
      Set_First_Declarative_Item_Of
334
        (Project_Declaration, In_Tree, Source_Dirs_Declaration);
335
      Set_Extended_Project_Of (Project_Declaration, In_Tree, For_Project);
336
 
337
      --  Source_Dirs declaration
338
 
339
      Set_Current_Item_Node
340
        (Source_Dirs_Declaration, In_Tree, Source_Dirs_Attribute);
341
 
342
      --  Source_Dirs attribute
343
 
344
      Set_Name_Of (Source_Dirs_Attribute, In_Tree, Snames.Name_Source_Dirs);
345
      Set_Expression_Of
346
        (Source_Dirs_Attribute, In_Tree, Source_Dirs_Expression);
347
 
348
      --  Source_Dirs expression
349
 
350
      Set_First_Term (Source_Dirs_Expression, In_Tree, Source_Dirs_Term);
351
 
352
      --  Source_Dirs term
353
 
354
      Set_Current_Term (Source_Dirs_Term, In_Tree, Source_Dirs_List);
355
 
356
      --  Source_Dirs empty list: nothing to do
357
   end Create_Virtual_Extending_Project;
358
 
359
   -----------------------------------
360
   -- Look_For_Virtual_Projects_For --
361
   -----------------------------------
362
 
363
   procedure Look_For_Virtual_Projects_For
364
     (Proj                : Project_Node_Id;
365
      In_Tree             : Project_Node_Tree_Ref;
366
      Potentially_Virtual : Boolean)
367
   is
368
      Declaration : Project_Node_Id := Empty_Node;
369
      --  Node for the project declaration of Proj
370
 
371
      With_Clause : Project_Node_Id := Empty_Node;
372
      --  Node for a with clause of Proj
373
 
374
      Imported    : Project_Node_Id := Empty_Node;
375
      --  Node for a project imported by Proj
376
 
377
      Extended    : Project_Node_Id := Empty_Node;
378
      --  Node for the eventual project extended by Proj
379
 
380
   begin
381
      --  Nothing to do if Proj is not defined or if it has already been
382
      --  processed.
383
 
384
      if Present (Proj) and then not Processed_Hash.Get (Proj) then
385
         --  Make sure the project will not be processed again
386
 
387
         Processed_Hash.Set (Proj, True);
388
 
389
         Declaration := Project_Declaration_Of (Proj, In_Tree);
390
 
391
         if Present (Declaration) then
392
            Extended := Extended_Project_Of (Declaration, In_Tree);
393
         end if;
394
 
395
         --  If this is a project that may need a virtual extending project
396
         --  and it is not itself an extending project, put it in the list.
397
 
398
         if Potentially_Virtual and then No (Extended) then
399
            Virtual_Hash.Set (Proj, Proj);
400
         end if;
401
 
402
         --  Now check the projects it imports
403
 
404
         With_Clause := First_With_Clause_Of (Proj, In_Tree);
405
 
406
         while Present (With_Clause) loop
407
            Imported := Project_Node_Of (With_Clause, In_Tree);
408
 
409
            if Present (Imported) then
410
               Look_For_Virtual_Projects_For
411
                 (Imported, In_Tree, Potentially_Virtual => True);
412
            end if;
413
 
414
            With_Clause := Next_With_Clause_Of (With_Clause, In_Tree);
415
         end loop;
416
 
417
         --  Check also the eventual project extended by Proj. As this project
418
         --  is already extended, call recursively with Potentially_Virtual
419
         --  being False.
420
 
421
         Look_For_Virtual_Projects_For
422
           (Extended, In_Tree, Potentially_Virtual => False);
423
      end if;
424
   end Look_For_Virtual_Projects_For;
425
 
426
   -----------
427
   -- Parse --
428
   -----------
429
 
430
   procedure Parse
431
     (In_Tree                : Project_Node_Tree_Ref;
432
      Project                : out Project_Node_Id;
433
      Project_File_Name      : String;
434
      Always_Errout_Finalize : Boolean;
435
      Packages_To_Check      : String_List_Access := All_Packages;
436
      Store_Comments         : Boolean := False;
437
      Current_Directory      : String := "";
438
      Is_Config_File         : Boolean;
439
      Flags                  : Processing_Flags)
440
   is
441
      Dummy : Boolean;
442
      pragma Warnings (Off, Dummy);
443
 
444
      Real_Project_File_Name : String_Access :=
445
                                 Osint.To_Canonical_File_Spec
446
                                   (Project_File_Name);
447
 
448
   begin
449
      if Real_Project_File_Name = null then
450
         Real_Project_File_Name := new String'(Project_File_Name);
451
      end if;
452
 
453
      Project := Empty_Node;
454
 
455
      Projects_Paths.Reset;
456
 
457
      if Current_Verbosity >= Medium then
458
         Write_Str ("GPR_PROJECT_PATH=""");
459
         Write_Str (Project_Path (In_Tree));
460
         Write_Line ("""");
461
      end if;
462
 
463
      declare
464
         Path_Name : constant String :=
465
                       Project_Path_Name_Of (In_Tree,
466
                                             Real_Project_File_Name.all,
467
                                             Directory   => Current_Directory);
468
 
469
      begin
470
         Free (Real_Project_File_Name);
471
 
472
         Prj.Err.Initialize;
473
         Prj.Err.Scanner.Set_Comment_As_Token (Store_Comments);
474
         Prj.Err.Scanner.Set_End_Of_Line_As_Token (Store_Comments);
475
 
476
         --  Parse the main project file
477
 
478
         if Path_Name = "" then
479
            Prj.Com.Fail
480
              ("project file """
481
               & Project_File_Name
482
               & """ not found in "
483
               & Project_Path (In_Tree));
484
            Project := Empty_Node;
485
            return;
486
         end if;
487
 
488
         begin
489
            Parse_Single_Project
490
              (In_Tree           => In_Tree,
491
               Project           => Project,
492
               Extends_All       => Dummy,
493
               Path_Name         => Path_Name,
494
               Extended          => False,
495
               From_Extended     => None,
496
               In_Limited        => False,
497
               Packages_To_Check => Packages_To_Check,
498
               Depth             => 0,
499
               Current_Dir       => Current_Directory,
500
               Is_Config_File    => Is_Config_File,
501
               Flags             => Flags);
502
 
503
         exception
504
            when Types.Unrecoverable_Error =>
505
               --  Unrecoverable_Error is raised when a line is too long.
506
               --  A meaningful error message will be displayed later.
507
               Project := Empty_Node;
508
         end;
509
 
510
         --  If Project is an extending-all project, create the eventual
511
         --  virtual extending projects and check that there are no illegally
512
         --  imported projects.
513
 
514
         if Present (Project)
515
           and then Is_Extending_All (Project, In_Tree)
516
         then
517
            --  First look for projects that potentially need a virtual
518
            --  extending project.
519
 
520
            Virtual_Hash.Reset;
521
            Processed_Hash.Reset;
522
 
523
            --  Mark the extending all project as processed, to avoid checking
524
            --  the imported projects in case of a "limited with" on this
525
            --  extending all project.
526
 
527
            Processed_Hash.Set (Project, True);
528
 
529
            declare
530
               Declaration : constant Project_Node_Id :=
531
                               Project_Declaration_Of (Project, In_Tree);
532
            begin
533
               Look_For_Virtual_Projects_For
534
                 (Extended_Project_Of (Declaration, In_Tree), In_Tree,
535
                  Potentially_Virtual => False);
536
            end;
537
 
538
            --  Now, check the projects directly imported by the main project.
539
            --  Remove from the potentially virtual any project extended by one
540
            --  of these imported projects. For non extending imported
541
            --  projects, check that they do not belong to the project tree of
542
            --  the project being "extended-all" by the main project.
543
 
544
            declare
545
               With_Clause : Project_Node_Id;
546
               Imported    : Project_Node_Id := Empty_Node;
547
               Declaration : Project_Node_Id := Empty_Node;
548
 
549
            begin
550
               With_Clause := First_With_Clause_Of (Project, In_Tree);
551
               while Present (With_Clause) loop
552
                  Imported := Project_Node_Of (With_Clause, In_Tree);
553
 
554
                  if Present (Imported) then
555
                     Declaration := Project_Declaration_Of (Imported, In_Tree);
556
 
557
                     if Extended_Project_Of (Declaration, In_Tree) /=
558
                               Empty_Node
559
                     then
560
                        loop
561
                           Imported :=
562
                             Extended_Project_Of (Declaration, In_Tree);
563
                           exit when No (Imported);
564
                           Virtual_Hash.Remove (Imported);
565
                           Declaration :=
566
                             Project_Declaration_Of (Imported, In_Tree);
567
                        end loop;
568
                     end if;
569
                  end if;
570
 
571
                  With_Clause := Next_With_Clause_Of (With_Clause, In_Tree);
572
               end loop;
573
            end;
574
 
575
            --  Now create all the virtual extending projects
576
 
577
            declare
578
               Proj : Project_Node_Id := Virtual_Hash.Get_First;
579
            begin
580
               while Present (Proj) loop
581
                  Create_Virtual_Extending_Project (Proj, Project, In_Tree);
582
                  Proj := Virtual_Hash.Get_Next;
583
               end loop;
584
            end;
585
         end if;
586
 
587
         --  If there were any kind of error during the parsing, serious
588
         --  or not, then the parsing fails.
589
 
590
         if Err_Vars.Total_Errors_Detected > 0 then
591
            Project := Empty_Node;
592
         end if;
593
 
594
         if No (Project) or else Always_Errout_Finalize then
595
            Prj.Err.Finalize;
596
 
597
            --  Reinitialize to avoid duplicate warnings later on
598
 
599
            Prj.Err.Initialize;
600
         end if;
601
      end;
602
 
603
   exception
604
      when X : others =>
605
 
606
         --  Internal error
607
 
608
         Write_Line (Exception_Information (X));
609
         Write_Str  ("Exception ");
610
         Write_Str  (Exception_Name (X));
611
         Write_Line (" raised, while processing project file");
612
         Project := Empty_Node;
613
   end Parse;
614
 
615
   ------------------------------
616
   -- Pre_Parse_Context_Clause --
617
   ------------------------------
618
 
619
   procedure Pre_Parse_Context_Clause
620
     (In_Tree        : Project_Node_Tree_Ref;
621
      Context_Clause : out With_Id;
622
      Is_Config_File : Boolean;
623
      Flags          : Processing_Flags)
624
   is
625
      Current_With_Clause : With_Id := No_With;
626
      Limited_With        : Boolean := False;
627
      Current_With        : With_Record;
628
      Current_With_Node   : Project_Node_Id := Empty_Node;
629
 
630
   begin
631
      --  Assume no context clause
632
 
633
      Context_Clause := No_With;
634
      With_Loop :
635
 
636
      --  If Token is not WITH or LIMITED, there is no context clause, or we
637
      --  have exhausted the with clauses.
638
 
639
      while Token = Tok_With or else Token = Tok_Limited loop
640
         Current_With_Node :=
641
           Default_Project_Node (Of_Kind => N_With_Clause, In_Tree => In_Tree);
642
         Limited_With := Token = Tok_Limited;
643
 
644
         if Is_Config_File then
645
            Error_Msg
646
              (Flags,
647
               "configuration project cannot import " &
648
               "other configuration projects",
649
               Token_Ptr);
650
         end if;
651
 
652
         if Limited_With then
653
            Scan (In_Tree);  --  scan past LIMITED
654
            Expect (Tok_With, "WITH");
655
            exit With_Loop when Token /= Tok_With;
656
         end if;
657
 
658
         Comma_Loop :
659
         loop
660
            Scan (In_Tree); -- past WITH or ","
661
 
662
            Expect (Tok_String_Literal, "literal string");
663
 
664
            if Token /= Tok_String_Literal then
665
               return;
666
            end if;
667
 
668
            --  Store path and location in table Withs
669
 
670
            Current_With :=
671
              (Path         => Path_Name_Type (Token_Name),
672
               Location     => Token_Ptr,
673
               Limited_With => Limited_With,
674
               Node         => Current_With_Node,
675
               Next         => No_With);
676
 
677
            Withs.Increment_Last;
678
            Withs.Table (Withs.Last) := Current_With;
679
 
680
            if Current_With_Clause = No_With then
681
               Context_Clause := Withs.Last;
682
 
683
            else
684
               Withs.Table (Current_With_Clause).Next := Withs.Last;
685
            end if;
686
 
687
            Current_With_Clause := Withs.Last;
688
 
689
            Scan (In_Tree);
690
 
691
            if Token = Tok_Semicolon then
692
               Set_End_Of_Line (Current_With_Node);
693
               Set_Previous_Line_Node (Current_With_Node);
694
 
695
               --  End of (possibly multiple) with clause;
696
 
697
               Scan (In_Tree); -- past the semicolon
698
               exit Comma_Loop;
699
 
700
            elsif Token = Tok_Comma then
701
               Set_Is_Not_Last_In_List (Current_With_Node, In_Tree);
702
 
703
            else
704
               Error_Msg (Flags, "expected comma or semi colon", Token_Ptr);
705
               exit Comma_Loop;
706
            end if;
707
 
708
            Current_With_Node :=
709
              Default_Project_Node
710
                (Of_Kind => N_With_Clause, In_Tree => In_Tree);
711
         end loop Comma_Loop;
712
      end loop With_Loop;
713
   end Pre_Parse_Context_Clause;
714
 
715
   -------------------------------
716
   -- Post_Parse_Context_Clause --
717
   -------------------------------
718
 
719
   procedure Post_Parse_Context_Clause
720
     (Context_Clause    : With_Id;
721
      In_Tree           : Project_Node_Tree_Ref;
722
      Limited_Withs     : Boolean;
723
      Imported_Projects : in out Project_Node_Id;
724
      Project_Directory : Path_Name_Type;
725
      From_Extended     : Extension_Origin;
726
      In_Limited        : Boolean;
727
      Packages_To_Check : String_List_Access;
728
      Depth             : Natural;
729
      Current_Dir       : String;
730
      Is_Config_File    : Boolean;
731
      Flags             : Processing_Flags)
732
   is
733
      Current_With_Clause : With_Id := Context_Clause;
734
 
735
      Current_Project  : Project_Node_Id := Imported_Projects;
736
      Previous_Project : Project_Node_Id := Empty_Node;
737
      Next_Project     : Project_Node_Id := Empty_Node;
738
 
739
      Project_Directory_Path : constant String :=
740
                                 Get_Name_String (Project_Directory);
741
 
742
      Current_With : With_Record;
743
      Extends_All  : Boolean := False;
744
 
745
   begin
746
      --  Set Current_Project to the last project in the current list, if the
747
      --  list is not empty.
748
 
749
      if Present (Current_Project) then
750
         while
751
           Present (Next_With_Clause_Of (Current_Project, In_Tree))
752
         loop
753
            Current_Project := Next_With_Clause_Of (Current_Project, In_Tree);
754
         end loop;
755
      end if;
756
 
757
      while Current_With_Clause /= No_With loop
758
         Current_With := Withs.Table (Current_With_Clause);
759
         Current_With_Clause := Current_With.Next;
760
 
761
         if Limited_Withs = Current_With.Limited_With then
762
            declare
763
               Original_Path : constant String :=
764
                                 Get_Name_String (Current_With.Path);
765
 
766
               Imported_Path_Name : constant String :=
767
                                      Project_Path_Name_Of
768
                                        (In_Tree,
769
                                         Original_Path,
770
                                         Project_Directory_Path);
771
 
772
               Resolved_Path : constant String :=
773
                                 Normalize_Pathname
774
                                   (Imported_Path_Name,
775
                                    Directory      => Current_Dir,
776
                                    Resolve_Links  =>
777
                                      Opt.Follow_Links_For_Files,
778
                                    Case_Sensitive => True);
779
 
780
               Withed_Project : Project_Node_Id := Empty_Node;
781
 
782
            begin
783
               if Imported_Path_Name = "" then
784
 
785
                  --  The project file cannot be found
786
 
787
                  Error_Msg_File_1 := File_Name_Type (Current_With.Path);
788
                  Error_Msg
789
                    (Flags, "unknown project file: {", Current_With.Location);
790
 
791
                  --  If this is not imported by the main project file, display
792
                  --  the import path.
793
 
794
                  if Project_Stack.Last > 1 then
795
                     for Index in reverse 1 .. Project_Stack.Last loop
796
                        Error_Msg_File_1 :=
797
                          File_Name_Type
798
                            (Project_Stack.Table (Index).Path_Name);
799
                        Error_Msg
800
                          (Flags, "\imported by {", Current_With.Location);
801
                     end loop;
802
                  end if;
803
 
804
               else
805
                  --  New with clause
806
 
807
                  Previous_Project := Current_Project;
808
 
809
                  if No (Current_Project) then
810
 
811
                     --  First with clause of the context clause
812
 
813
                     Current_Project := Current_With.Node;
814
                     Imported_Projects := Current_Project;
815
 
816
                  else
817
                     Next_Project := Current_With.Node;
818
                     Set_Next_With_Clause_Of
819
                       (Current_Project, In_Tree, Next_Project);
820
                     Current_Project := Next_Project;
821
                  end if;
822
 
823
                  Set_String_Value_Of
824
                    (Current_Project,
825
                     In_Tree,
826
                     Name_Id (Current_With.Path));
827
                  Set_Location_Of
828
                    (Current_Project, In_Tree, Current_With.Location);
829
 
830
                  --  If it is a limited with, check if we have a circularity.
831
                  --  If we have one, get the project id of the limited
832
                  --  imported project file, and do not parse it.
833
 
834
                  if Limited_Withs and then Project_Stack.Last > 1 then
835
                     declare
836
                        Canonical_Path_Name : Path_Name_Type;
837
 
838
                     begin
839
                        Name_Len := Resolved_Path'Length;
840
                        Name_Buffer (1 .. Name_Len) := Resolved_Path;
841
                        Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
842
                        Canonical_Path_Name := Name_Find;
843
 
844
                        for Index in 1 .. Project_Stack.Last loop
845
                           if Project_Stack.Table (Index).Canonical_Path_Name =
846
                             Canonical_Path_Name
847
                           then
848
                              --  We have found the limited imported project,
849
                              --  get its project id, and do not parse it.
850
 
851
                              Withed_Project := Project_Stack.Table (Index).Id;
852
                              exit;
853
                           end if;
854
                        end loop;
855
                     end;
856
                  end if;
857
 
858
                  --  Parse the imported project, if its project id is unknown
859
 
860
                  if No (Withed_Project) then
861
                     Parse_Single_Project
862
                       (In_Tree           => In_Tree,
863
                        Project           => Withed_Project,
864
                        Extends_All       => Extends_All,
865
                        Path_Name         => Imported_Path_Name,
866
                        Extended          => False,
867
                        From_Extended     => From_Extended,
868
                        In_Limited        => Limited_Withs,
869
                        Packages_To_Check => Packages_To_Check,
870
                        Depth             => Depth,
871
                        Current_Dir       => Current_Dir,
872
                        Is_Config_File    => Is_Config_File,
873
                        Flags             => Flags);
874
 
875
                  else
876
                     Extends_All := Is_Extending_All (Withed_Project, In_Tree);
877
                  end if;
878
 
879
                  if No (Withed_Project) then
880
 
881
                     --  If parsing unsuccessful, remove the context clause
882
 
883
                     Current_Project := Previous_Project;
884
 
885
                     if No (Current_Project) then
886
                        Imported_Projects := Empty_Node;
887
 
888
                     else
889
                        Set_Next_With_Clause_Of
890
                          (Current_Project, In_Tree, Empty_Node);
891
                     end if;
892
                  else
893
                     --  If parsing was successful, record project name and
894
                     --  path name in with clause
895
 
896
                     Set_Project_Node_Of
897
                       (Node         => Current_Project,
898
                        In_Tree      => In_Tree,
899
                        To           => Withed_Project,
900
                        Limited_With => Current_With.Limited_With);
901
                     Set_Name_Of
902
                       (Current_Project,
903
                        In_Tree,
904
                        Name_Of (Withed_Project, In_Tree));
905
 
906
                     Name_Len := Resolved_Path'Length;
907
                     Name_Buffer (1 .. Name_Len) := Resolved_Path;
908
                     Set_Path_Name_Of (Current_Project, In_Tree, Name_Find);
909
 
910
                     if Extends_All then
911
                        Set_Is_Extending_All (Current_Project, In_Tree);
912
                     end if;
913
                  end if;
914
               end if;
915
            end;
916
         end if;
917
      end loop;
918
   end Post_Parse_Context_Clause;
919
 
920
   --------------------------
921
   -- Parse_Single_Project --
922
   --------------------------
923
 
924
   procedure Parse_Single_Project
925
     (In_Tree           : Project_Node_Tree_Ref;
926
      Project           : out Project_Node_Id;
927
      Extends_All       : out Boolean;
928
      Path_Name         : String;
929
      Extended          : Boolean;
930
      From_Extended     : Extension_Origin;
931
      In_Limited        : Boolean;
932
      Packages_To_Check : String_List_Access;
933
      Depth             : Natural;
934
      Current_Dir       : String;
935
      Is_Config_File    : Boolean;
936
      Flags             : Processing_Flags)
937
   is
938
      Normed_Path_Name    : Path_Name_Type;
939
      Canonical_Path_Name : Path_Name_Type;
940
      Project_Directory   : Path_Name_Type;
941
      Project_Scan_State  : Saved_Project_Scan_State;
942
      Source_Index        : Source_File_Index;
943
 
944
      Extending : Boolean := False;
945
 
946
      Extended_Project : Project_Node_Id := Empty_Node;
947
 
948
      A_Project_Name_And_Node : Tree_Private_Part.Project_Name_And_Node :=
949
                                  Tree_Private_Part.Projects_Htable.Get_First
950
                                    (In_Tree.Projects_HT);
951
 
952
      Name_From_Path  : constant Name_Id :=
953
        Project_Name_From (Path_Name, Is_Config_File => Is_Config_File);
954
      Name_Of_Project : Name_Id := No_Name;
955
      Display_Name_Of_Project : Name_Id := No_Name;
956
 
957
      Duplicated : Boolean := False;
958
 
959
      First_With        : With_Id;
960
      Imported_Projects : Project_Node_Id := Empty_Node;
961
 
962
      use Tree_Private_Part;
963
 
964
      Project_Comment_State : Tree.Comment_State;
965
 
966
      Proj_Qualifier     : Project_Qualifier := Unspecified;
967
      Qualifier_Location : Source_Ptr;
968
 
969
   begin
970
      Extends_All := False;
971
 
972
      declare
973
         Normed_Path    : constant String := Normalize_Pathname
974
                            (Path_Name,
975
                             Directory      => Current_Dir,
976
                             Resolve_Links  => False,
977
                             Case_Sensitive => True);
978
         Canonical_Path : constant String := Normalize_Pathname
979
                            (Normed_Path,
980
                             Directory      => Current_Dir,
981
                             Resolve_Links  => Opt.Follow_Links_For_Files,
982
                             Case_Sensitive => False);
983
      begin
984
         Name_Len := Normed_Path'Length;
985
         Name_Buffer (1 .. Name_Len) := Normed_Path;
986
         Normed_Path_Name := Name_Find;
987
         Name_Len := Canonical_Path'Length;
988
         Name_Buffer (1 .. Name_Len) := Canonical_Path;
989
         Canonical_Path_Name := Name_Find;
990
      end;
991
 
992
      --  Check for a circular dependency
993
 
994
      for Index in reverse 1 .. Project_Stack.Last loop
995
         exit when Project_Stack.Table (Index).Limited_With;
996
 
997
         if Canonical_Path_Name =
998
              Project_Stack.Table (Index).Canonical_Path_Name
999
         then
1000
            Error_Msg (Flags, "circular dependency detected", Token_Ptr);
1001
            Error_Msg_Name_1 := Name_Id (Normed_Path_Name);
1002
            Error_Msg (Flags, "\  %% is imported by", Token_Ptr);
1003
 
1004
            for Current in reverse 1 .. Project_Stack.Last loop
1005
               Error_Msg_Name_1 :=
1006
                 Name_Id (Project_Stack.Table (Current).Path_Name);
1007
 
1008
               if Project_Stack.Table (Current).Canonical_Path_Name /=
1009
                    Canonical_Path_Name
1010
               then
1011
                  Error_Msg
1012
                    (Flags, "\  %% which itself is imported by", Token_Ptr);
1013
 
1014
               else
1015
                  Error_Msg (Flags, "\  %%", Token_Ptr);
1016
                  exit;
1017
               end if;
1018
            end loop;
1019
 
1020
            Project := Empty_Node;
1021
            return;
1022
         end if;
1023
      end loop;
1024
 
1025
      --  Put the new path name on the stack
1026
 
1027
      Project_Stack.Append
1028
        ((Path_Name           => Normed_Path_Name,
1029
          Canonical_Path_Name => Canonical_Path_Name,
1030
          Id                  => Empty_Node,
1031
          Limited_With        => In_Limited));
1032
 
1033
      --  Check if the project file has already been parsed
1034
 
1035
      while
1036
        A_Project_Name_And_Node /= Tree_Private_Part.No_Project_Name_And_Node
1037
      loop
1038
         if A_Project_Name_And_Node.Canonical_Path = Canonical_Path_Name then
1039
            if Extended then
1040
 
1041
               if A_Project_Name_And_Node.Extended then
1042
                  if A_Project_Name_And_Node.Proj_Qualifier /= Dry then
1043
                     Error_Msg
1044
                       (Flags,
1045
                        "cannot extend the same project file several times",
1046
                        Token_Ptr);
1047
                  end if;
1048
               else
1049
                  Error_Msg
1050
                    (Flags,
1051
                     "cannot extend an already imported project file",
1052
                     Token_Ptr);
1053
               end if;
1054
 
1055
            elsif A_Project_Name_And_Node.Extended then
1056
               Extends_All :=
1057
                 Is_Extending_All (A_Project_Name_And_Node.Node, In_Tree);
1058
 
1059
               --  If the imported project is an extended project A, and we are
1060
               --  in an extended project, replace A with the ultimate project
1061
               --  extending A.
1062
 
1063
               if From_Extended /= None then
1064
                  declare
1065
                     Decl : Project_Node_Id :=
1066
                              Project_Declaration_Of
1067
                                (A_Project_Name_And_Node.Node, In_Tree);
1068
 
1069
                     Prj  : Project_Node_Id :=
1070
                              A_Project_Name_And_Node.Node;
1071
 
1072
                  begin
1073
                     --  Loop through extending projects to find the ultimate
1074
                     --  extending project, that is the one that is not
1075
                     --  extended. For an abstract project, as it can be
1076
                     --  extended several times, there is no extending project
1077
                     --  registered, so the loop does not execute and the
1078
                     --  resulting project is the abstract project.
1079
 
1080
                     while
1081
                       Extending_Project_Of (Decl, In_Tree) /= Empty_Node
1082
                     loop
1083
                        Prj := Extending_Project_Of (Decl, In_Tree);
1084
                        Decl := Project_Declaration_Of (Prj, In_Tree);
1085
                     end loop;
1086
 
1087
                     A_Project_Name_And_Node.Node := Prj;
1088
                  end;
1089
               else
1090
                  Error_Msg
1091
                    (Flags,
1092
                     "cannot import an already extended project file",
1093
                     Token_Ptr);
1094
               end if;
1095
            end if;
1096
 
1097
            Project := A_Project_Name_And_Node.Node;
1098
            Project_Stack.Decrement_Last;
1099
            return;
1100
         end if;
1101
 
1102
         A_Project_Name_And_Node :=
1103
           Tree_Private_Part.Projects_Htable.Get_Next (In_Tree.Projects_HT);
1104
      end loop;
1105
 
1106
      --  We never encountered this project file. Save the scan state, load the
1107
      --  project file and start to scan it.
1108
 
1109
      Save_Project_Scan_State (Project_Scan_State);
1110
      Source_Index := Load_Project_File (Path_Name);
1111
      Tree.Save (Project_Comment_State);
1112
 
1113
      --  If we cannot find it, we stop
1114
 
1115
      if Source_Index = No_Source_File then
1116
         Project := Empty_Node;
1117
         Project_Stack.Decrement_Last;
1118
         return;
1119
      end if;
1120
 
1121
      Prj.Err.Scanner.Initialize_Scanner (Source_Index);
1122
      Tree.Reset_State;
1123
      Scan (In_Tree);
1124
 
1125
      if not Is_Config_File and then Name_From_Path = No_Name then
1126
 
1127
         --  The project file name is not correct (no or bad extension, or not
1128
         --  following Ada identifier's syntax).
1129
 
1130
         Error_Msg_File_1 := File_Name_Type (Canonical_Path_Name);
1131
         Error_Msg (Flags,
1132
                    "?{ is not a valid path name for a project file",
1133
                    Token_Ptr);
1134
      end if;
1135
 
1136
      if Current_Verbosity >= Medium then
1137
         Write_Str  ("Parsing """);
1138
         Write_Str  (Path_Name);
1139
         Write_Char ('"');
1140
         Write_Eol;
1141
      end if;
1142
 
1143
      Project_Directory :=
1144
        Path_Name_Type (Get_Directory (File_Name_Type (Normed_Path_Name)));
1145
 
1146
      --  Is there any imported project?
1147
 
1148
      Pre_Parse_Context_Clause
1149
        (In_Tree        => In_Tree,
1150
         Is_Config_File => Is_Config_File,
1151
         Context_Clause => First_With,
1152
         Flags          => Flags);
1153
 
1154
      Project := Default_Project_Node
1155
                   (Of_Kind => N_Project, In_Tree => In_Tree);
1156
      Project_Stack.Table (Project_Stack.Last).Id := Project;
1157
      Set_Directory_Of (Project, In_Tree, Project_Directory);
1158
      Set_Path_Name_Of (Project, In_Tree,  Normed_Path_Name);
1159
 
1160
      --  Check if there is a qualifier before the reserved word "project"
1161
 
1162
      Qualifier_Location := Token_Ptr;
1163
 
1164
      if Token = Tok_Abstract then
1165
         Proj_Qualifier := Dry;
1166
         Scan (In_Tree);
1167
 
1168
      elsif Token = Tok_Identifier then
1169
         case Token_Name is
1170
            when Snames.Name_Standard =>
1171
               Proj_Qualifier := Standard;
1172
               Scan (In_Tree);
1173
 
1174
            when Snames.Name_Aggregate =>
1175
               Proj_Qualifier := Aggregate;
1176
               Scan (In_Tree);
1177
 
1178
               if Token = Tok_Identifier and then
1179
                 Token_Name = Snames.Name_Library
1180
               then
1181
                  Proj_Qualifier := Aggregate_Library;
1182
                  Scan (In_Tree);
1183
               end if;
1184
 
1185
            when Snames.Name_Library =>
1186
               Proj_Qualifier := Library;
1187
               Scan (In_Tree);
1188
 
1189
            when Snames.Name_Configuration =>
1190
               if not Is_Config_File then
1191
                  Error_Msg
1192
                    (Flags,
1193
                     "configuration projects cannot belong to a user" &
1194
                     " project tree",
1195
                     Token_Ptr);
1196
               end if;
1197
 
1198
               Proj_Qualifier := Configuration;
1199
               Scan (In_Tree);
1200
 
1201
            when others =>
1202
               null;
1203
         end case;
1204
      end if;
1205
 
1206
      if Is_Config_File and then Proj_Qualifier = Unspecified then
1207
 
1208
         --  Set the qualifier to Configuration, even if the token doesn't
1209
         --  exist in the source file itself, so that we can differentiate
1210
         --  project files and configuration files later on.
1211
 
1212
         Proj_Qualifier := Configuration;
1213
      end if;
1214
 
1215
      if Proj_Qualifier /= Unspecified then
1216
         if Is_Config_File
1217
           and then Proj_Qualifier /= Configuration
1218
         then
1219
            Error_Msg (Flags,
1220
                       "a configuration project cannot be qualified except " &
1221
                       "as configuration project",
1222
                       Qualifier_Location);
1223
         end if;
1224
 
1225
         Set_Project_Qualifier_Of (Project, In_Tree, Proj_Qualifier);
1226
      end if;
1227
 
1228
      Set_Location_Of (Project, In_Tree, Token_Ptr);
1229
 
1230
      Expect (Tok_Project, "PROJECT");
1231
 
1232
      --  Mark location of PROJECT token if present
1233
 
1234
      if Token = Tok_Project then
1235
         Scan (In_Tree); -- past PROJECT
1236
         Set_Location_Of (Project, In_Tree, Token_Ptr);
1237
      end if;
1238
 
1239
      --  Clear the Buffer
1240
 
1241
      Buffer_Last := 0;
1242
      loop
1243
         Expect (Tok_Identifier, "identifier");
1244
 
1245
         --  If the token is not an identifier, clear the buffer before
1246
         --  exiting to indicate that the name of the project is ill-formed.
1247
 
1248
         if Token /= Tok_Identifier then
1249
            Buffer_Last := 0;
1250
            exit;
1251
         end if;
1252
 
1253
         --  Add the identifier name to the buffer
1254
 
1255
         Get_Name_String (Token_Name);
1256
         Add_To_Buffer (Name_Buffer (1 .. Name_Len), Buffer, Buffer_Last);
1257
 
1258
         --  Scan past the identifier
1259
 
1260
         Scan (In_Tree);
1261
 
1262
         --  If we have a dot, add a dot to the Buffer and look for the next
1263
         --  identifier.
1264
 
1265
         exit when Token /= Tok_Dot;
1266
         Add_To_Buffer (".", Buffer, Buffer_Last);
1267
 
1268
         --  Scan past the dot
1269
 
1270
         Scan (In_Tree);
1271
      end loop;
1272
 
1273
      --  See if this is an extending project
1274
 
1275
      if Token = Tok_Extends then
1276
 
1277
         if Is_Config_File then
1278
            Error_Msg
1279
              (Flags,
1280
               "extending configuration project not allowed", Token_Ptr);
1281
         end if;
1282
 
1283
         --  Make sure that gnatmake will use mapping files
1284
 
1285
         Create_Mapping_File := True;
1286
 
1287
         --  We are extending another project
1288
 
1289
         Extending := True;
1290
 
1291
         Scan (In_Tree); -- past EXTENDS
1292
 
1293
         if Token = Tok_All then
1294
            Extends_All := True;
1295
            Set_Is_Extending_All (Project, In_Tree);
1296
            Scan (In_Tree); --  scan past ALL
1297
         end if;
1298
      end if;
1299
 
1300
      --  If the name is well formed, Buffer_Last is > 0
1301
 
1302
      if Buffer_Last > 0 then
1303
 
1304
         --  The Buffer contains the name of the project
1305
 
1306
         Name_Len := Buffer_Last;
1307
         Name_Buffer (1 .. Name_Len) := Buffer (1 .. Buffer_Last);
1308
         Name_Of_Project := Name_Find;
1309
         Set_Name_Of (Project, In_Tree, Name_Of_Project);
1310
 
1311
         --  To get expected name of the project file, replace dots by dashes
1312
 
1313
         for Index in 1 .. Name_Len loop
1314
            if Name_Buffer (Index) = '.' then
1315
               Name_Buffer (Index) := '-';
1316
            end if;
1317
         end loop;
1318
 
1319
         Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
1320
 
1321
         declare
1322
            Expected_Name : constant Name_Id := Name_Find;
1323
            Extension     : String_Access;
1324
 
1325
         begin
1326
            --  Output a warning if the actual name is not the expected name
1327
 
1328
            if not Is_Config_File
1329
              and then (Name_From_Path /= No_Name)
1330
              and then Expected_Name /= Name_From_Path
1331
            then
1332
               Error_Msg_Name_1 := Expected_Name;
1333
 
1334
               if Is_Config_File then
1335
                  Extension := new String'(Config_Project_File_Extension);
1336
 
1337
               else
1338
                  Extension := new String'(Project_File_Extension);
1339
               end if;
1340
 
1341
               Error_Msg
1342
                 (Flags,
1343
                  "?file name does not match project name, should be `%%"
1344
                  & Extension.all & "`",
1345
                  Token_Ptr);
1346
            end if;
1347
         end;
1348
 
1349
         --  Read the original casing of the project name
1350
 
1351
         declare
1352
            Loc : Source_Ptr;
1353
 
1354
         begin
1355
            Loc := Location_Of (Project, In_Tree);
1356
            for J in 1 .. Name_Len loop
1357
               Name_Buffer (J) := Sinput.Source (Loc);
1358
               Loc := Loc + 1;
1359
            end loop;
1360
 
1361
            Display_Name_Of_Project := Name_Find;
1362
         end;
1363
 
1364
         declare
1365
            From_Ext : Extension_Origin := None;
1366
 
1367
         begin
1368
            --  Extending_All is always propagated
1369
 
1370
            if From_Extended = Extending_All or else Extends_All then
1371
               From_Ext := Extending_All;
1372
 
1373
            --  Otherwise, From_Extended is set to Extending_Single if the
1374
            --  current project is an extending project.
1375
 
1376
            elsif Extended then
1377
               From_Ext := Extending_Simple;
1378
            end if;
1379
 
1380
            Post_Parse_Context_Clause
1381
              (In_Tree           => In_Tree,
1382
               Context_Clause    => First_With,
1383
               Limited_Withs     => False,
1384
               Imported_Projects => Imported_Projects,
1385
               Project_Directory => Project_Directory,
1386
               From_Extended     => From_Ext,
1387
               In_Limited        => In_Limited,
1388
               Packages_To_Check => Packages_To_Check,
1389
               Depth             => Depth + 1,
1390
               Current_Dir       => Current_Dir,
1391
               Is_Config_File    => Is_Config_File,
1392
               Flags             => Flags);
1393
            Set_First_With_Clause_Of (Project, In_Tree, Imported_Projects);
1394
         end;
1395
 
1396
         if not Is_Config_File then
1397
            declare
1398
               Name_And_Node : Tree_Private_Part.Project_Name_And_Node :=
1399
                                 Tree_Private_Part.Projects_Htable.Get_First
1400
                                   (In_Tree.Projects_HT);
1401
               Project_Name  : Name_Id := Name_And_Node.Name;
1402
 
1403
            begin
1404
               --  Check if we already have a project with this name
1405
 
1406
               while Project_Name /= No_Name
1407
                 and then Project_Name /= Name_Of_Project
1408
               loop
1409
                  Name_And_Node :=
1410
                    Tree_Private_Part.Projects_Htable.Get_Next
1411
                      (In_Tree.Projects_HT);
1412
                  Project_Name := Name_And_Node.Name;
1413
               end loop;
1414
 
1415
               --  Report an error if we already have a project with this name
1416
 
1417
               if Project_Name /= No_Name then
1418
                  Duplicated := True;
1419
                  Error_Msg_Name_1 := Project_Name;
1420
                  Error_Msg
1421
                    (Flags, "duplicate project name %%",
1422
                     Location_Of (Project, In_Tree));
1423
                  Error_Msg_Name_1 :=
1424
                    Name_Id (Path_Name_Of (Name_And_Node.Node, In_Tree));
1425
                  Error_Msg
1426
                    (Flags, "\already in %%", Location_Of (Project, In_Tree));
1427
               end if;
1428
            end;
1429
         end if;
1430
 
1431
      end if;
1432
 
1433
      if Extending then
1434
         Expect (Tok_String_Literal, "literal string");
1435
 
1436
         if Token = Tok_String_Literal then
1437
            Set_Extended_Project_Path_Of
1438
              (Project,
1439
               In_Tree,
1440
               Path_Name_Type (Token_Name));
1441
 
1442
            declare
1443
               Original_Path_Name : constant String :=
1444
                                      Get_Name_String (Token_Name);
1445
 
1446
               Extended_Project_Path_Name : constant String :=
1447
                                              Project_Path_Name_Of
1448
                                                (In_Tree,
1449
                                                 Original_Path_Name,
1450
                                                 Get_Name_String
1451
                                                   (Project_Directory));
1452
 
1453
            begin
1454
               if Extended_Project_Path_Name = "" then
1455
 
1456
                  --  We could not find the project file to extend
1457
 
1458
                  Error_Msg_Name_1 := Token_Name;
1459
 
1460
                  Error_Msg (Flags, "unknown project file: %%", Token_Ptr);
1461
 
1462
                  --  If we are not in the main project file, display the
1463
                  --  import path.
1464
 
1465
                  if Project_Stack.Last > 1 then
1466
                     Error_Msg_Name_1 :=
1467
                       Name_Id
1468
                         (Project_Stack.Table (Project_Stack.Last).Path_Name);
1469
                     Error_Msg (Flags, "\extended by %%", Token_Ptr);
1470
 
1471
                     for Index in reverse 1 .. Project_Stack.Last - 1 loop
1472
                        Error_Msg_Name_1 :=
1473
                          Name_Id
1474
                            (Project_Stack.Table (Index).Path_Name);
1475
                        Error_Msg (Flags, "\imported by %%", Token_Ptr);
1476
                     end loop;
1477
                  end if;
1478
 
1479
               else
1480
                  declare
1481
                     From_Ext : Extension_Origin := None;
1482
 
1483
                  begin
1484
                     if From_Extended = Extending_All or else Extends_All then
1485
                        From_Ext := Extending_All;
1486
                     end if;
1487
 
1488
                     Parse_Single_Project
1489
                       (In_Tree           => In_Tree,
1490
                        Project           => Extended_Project,
1491
                        Extends_All       => Extends_All,
1492
                        Path_Name         => Extended_Project_Path_Name,
1493
                        Extended          => True,
1494
                        From_Extended     => From_Ext,
1495
                        In_Limited        => In_Limited,
1496
                        Packages_To_Check => Packages_To_Check,
1497
                        Depth             => Depth + 1,
1498
                        Current_Dir       => Current_Dir,
1499
                        Is_Config_File    => Is_Config_File,
1500
                        Flags             => Flags);
1501
                  end;
1502
 
1503
                  if Present (Extended_Project) then
1504
 
1505
                     --  A project that extends an extending-all project is
1506
                     --  also an extending-all project.
1507
 
1508
                     if Is_Extending_All (Extended_Project, In_Tree) then
1509
                        Set_Is_Extending_All (Project, In_Tree);
1510
                     end if;
1511
 
1512
                     --  An abstract project can only extend an abstract
1513
                     --  project, otherwise we may have an abstract project
1514
                     --  with sources, if it inherits sources from the project
1515
                     --  it extends.
1516
 
1517
                     if Proj_Qualifier = Dry and then
1518
                       Project_Qualifier_Of (Extended_Project, In_Tree) /= Dry
1519
                     then
1520
                        Error_Msg
1521
                          (Flags, "an abstract project can only extend " &
1522
                           "another abstract project",
1523
                           Qualifier_Location);
1524
                     end if;
1525
                  end if;
1526
               end if;
1527
            end;
1528
 
1529
            Scan (In_Tree); -- past the extended project path
1530
         end if;
1531
      end if;
1532
 
1533
      --  Check that a non extending-all project does not import an
1534
      --  extending-all project.
1535
 
1536
      if not Is_Extending_All (Project, In_Tree) then
1537
         declare
1538
            With_Clause : Project_Node_Id :=
1539
                            First_With_Clause_Of (Project, In_Tree);
1540
            Imported    : Project_Node_Id := Empty_Node;
1541
 
1542
         begin
1543
            With_Clause_Loop :
1544
            while Present (With_Clause) loop
1545
               Imported := Project_Node_Of (With_Clause, In_Tree);
1546
 
1547
               if Is_Extending_All (With_Clause, In_Tree) then
1548
                  Error_Msg_Name_1 := Name_Of (Imported, In_Tree);
1549
                  Error_Msg (Flags, "cannot import extending-all project %%",
1550
                             Token_Ptr);
1551
                  exit With_Clause_Loop;
1552
               end if;
1553
 
1554
               With_Clause := Next_With_Clause_Of (With_Clause, In_Tree);
1555
            end loop With_Clause_Loop;
1556
         end;
1557
      end if;
1558
 
1559
      --  Check that a project with a name including a dot either imports
1560
      --  or extends the project whose name precedes the last dot.
1561
 
1562
      if Name_Of_Project /= No_Name then
1563
         Get_Name_String (Name_Of_Project);
1564
 
1565
      else
1566
         Name_Len := 0;
1567
      end if;
1568
 
1569
      --  Look for the last dot
1570
 
1571
      while Name_Len > 0 and then Name_Buffer (Name_Len) /= '.' loop
1572
         Name_Len := Name_Len - 1;
1573
      end loop;
1574
 
1575
      --  If a dot was find, check if the parent project is imported
1576
      --  or extended.
1577
 
1578
      if Name_Len > 0 then
1579
         Name_Len := Name_Len - 1;
1580
 
1581
         declare
1582
            Parent_Name  : constant Name_Id := Name_Find;
1583
            Parent_Found : Boolean := False;
1584
            Parent_Node  : Project_Node_Id := Empty_Node;
1585
            With_Clause  : Project_Node_Id :=
1586
                             First_With_Clause_Of (Project, In_Tree);
1587
 
1588
         begin
1589
            --  If there is an extended project, check its name
1590
 
1591
            if Present (Extended_Project) then
1592
               Parent_Node := Extended_Project;
1593
               Parent_Found :=
1594
                 Name_Of (Extended_Project, In_Tree) = Parent_Name;
1595
            end if;
1596
 
1597
            --  If the parent project is not the extended project,
1598
            --  check each imported project until we find the parent project.
1599
 
1600
            while not Parent_Found and then Present (With_Clause) loop
1601
               Parent_Node := Project_Node_Of (With_Clause, In_Tree);
1602
               Parent_Found := Name_Of (Parent_Node, In_Tree) = Parent_Name;
1603
               With_Clause := Next_With_Clause_Of (With_Clause, In_Tree);
1604
            end loop;
1605
 
1606
            if Parent_Found then
1607
               Set_Parent_Project_Of (Project, In_Tree, To => Parent_Node);
1608
 
1609
            else
1610
               --  If the parent project was not found, report an error
1611
 
1612
               Error_Msg_Name_1 := Name_Of_Project;
1613
               Error_Msg_Name_2 := Parent_Name;
1614
               Error_Msg (Flags,
1615
                          "project %% does not import or extend project %%",
1616
                          Location_Of (Project, In_Tree));
1617
            end if;
1618
         end;
1619
      end if;
1620
 
1621
      Expect (Tok_Is, "IS");
1622
      Set_End_Of_Line (Project);
1623
      Set_Previous_Line_Node (Project);
1624
      Set_Next_End_Node (Project);
1625
 
1626
      declare
1627
         Project_Declaration : Project_Node_Id := Empty_Node;
1628
 
1629
      begin
1630
         --  No need to Scan past "is", Prj.Dect.Parse will do it
1631
 
1632
         Prj.Dect.Parse
1633
           (In_Tree           => In_Tree,
1634
            Declarations      => Project_Declaration,
1635
            Current_Project   => Project,
1636
            Extends           => Extended_Project,
1637
            Packages_To_Check => Packages_To_Check,
1638
            Is_Config_File    => Is_Config_File,
1639
            Flags             => Flags);
1640
         Set_Project_Declaration_Of (Project, In_Tree, Project_Declaration);
1641
 
1642
         if Present (Extended_Project)
1643
           and then Project_Qualifier_Of (Extended_Project, In_Tree) /= Dry
1644
         then
1645
            Set_Extending_Project_Of
1646
              (Project_Declaration_Of (Extended_Project, In_Tree), In_Tree,
1647
               To => Project);
1648
         end if;
1649
      end;
1650
 
1651
      Expect (Tok_End, "END");
1652
      Remove_Next_End_Node;
1653
 
1654
      --  Skip "end" if present
1655
 
1656
      if Token = Tok_End then
1657
         Scan (In_Tree);
1658
      end if;
1659
 
1660
      --  Clear the Buffer
1661
 
1662
      Buffer_Last := 0;
1663
 
1664
      --  Store the name following "end" in the Buffer. The name may be made of
1665
      --  several simple names.
1666
 
1667
      loop
1668
         Expect (Tok_Identifier, "identifier");
1669
 
1670
         --  If we don't have an identifier, clear the buffer before exiting to
1671
         --  avoid checking the name.
1672
 
1673
         if Token /= Tok_Identifier then
1674
            Buffer_Last := 0;
1675
            exit;
1676
         end if;
1677
 
1678
         --  Add the identifier to the Buffer
1679
         Get_Name_String (Token_Name);
1680
         Add_To_Buffer (Name_Buffer (1 .. Name_Len), Buffer, Buffer_Last);
1681
 
1682
         --  Scan past the identifier
1683
 
1684
         Scan (In_Tree);
1685
         exit when Token /= Tok_Dot;
1686
         Add_To_Buffer (".", Buffer, Buffer_Last);
1687
         Scan (In_Tree);
1688
      end loop;
1689
 
1690
      --  If we have a valid name, check if it is the name of the project
1691
 
1692
      if Name_Of_Project /= No_Name and then Buffer_Last > 0 then
1693
         if To_Lower (Buffer (1 .. Buffer_Last)) /=
1694
            Get_Name_String (Name_Of (Project, In_Tree))
1695
         then
1696
            --  Invalid name: report an error
1697
 
1698
            Error_Msg (Flags, "expected """ &
1699
                       Get_Name_String (Name_Of (Project, In_Tree)) & """",
1700
                       Token_Ptr);
1701
         end if;
1702
      end if;
1703
 
1704
      Expect (Tok_Semicolon, "`;`");
1705
 
1706
      --  Check that there is no more text following the end of the project
1707
      --  source.
1708
 
1709
      if Token = Tok_Semicolon then
1710
         Set_Previous_End_Node (Project);
1711
         Scan (In_Tree);
1712
 
1713
         if Token /= Tok_EOF then
1714
            Error_Msg
1715
              (Flags, "unexpected text following end of project", Token_Ptr);
1716
         end if;
1717
      end if;
1718
 
1719
      if not Duplicated and then Name_Of_Project /= No_Name then
1720
 
1721
         --  Add the name of the project to the hash table, so that we can
1722
         --  check that no other subsequent project will have the same name.
1723
 
1724
         Tree_Private_Part.Projects_Htable.Set
1725
           (T => In_Tree.Projects_HT,
1726
            K => Name_Of_Project,
1727
            E => (Name           => Name_Of_Project,
1728
                  Display_Name   => Display_Name_Of_Project,
1729
                  Node           => Project,
1730
                  Canonical_Path => Canonical_Path_Name,
1731
                  Extended       => Extended,
1732
                  Proj_Qualifier => Proj_Qualifier));
1733
      end if;
1734
 
1735
      declare
1736
         From_Ext : Extension_Origin := None;
1737
 
1738
      begin
1739
         --  Extending_All is always propagated
1740
 
1741
         if From_Extended = Extending_All or else Extends_All then
1742
            From_Ext := Extending_All;
1743
 
1744
            --  Otherwise, From_Extended is set to Extending_Single if the
1745
            --  current project is an extending project.
1746
 
1747
         elsif Extended then
1748
            From_Ext := Extending_Simple;
1749
         end if;
1750
 
1751
         Post_Parse_Context_Clause
1752
           (In_Tree           => In_Tree,
1753
            Context_Clause    => First_With,
1754
            Limited_Withs     => True,
1755
            Imported_Projects => Imported_Projects,
1756
            Project_Directory => Project_Directory,
1757
            From_Extended     => From_Ext,
1758
            In_Limited        => In_Limited,
1759
            Packages_To_Check => Packages_To_Check,
1760
            Depth             => Depth + 1,
1761
            Current_Dir       => Current_Dir,
1762
            Is_Config_File    => Is_Config_File,
1763
            Flags             => Flags);
1764
         Set_First_With_Clause_Of (Project, In_Tree, Imported_Projects);
1765
      end;
1766
 
1767
      --  Restore the scan state, in case we are not the main project
1768
 
1769
      Restore_Project_Scan_State (Project_Scan_State);
1770
 
1771
      --  And remove the project from the project stack
1772
 
1773
      Project_Stack.Decrement_Last;
1774
 
1775
      --  Indicate if there are unkept comments
1776
 
1777
      Tree.Set_Project_File_Includes_Unkept_Comments
1778
        (Node    => Project,
1779
         In_Tree => In_Tree,
1780
         To      => Tree.There_Are_Unkept_Comments);
1781
 
1782
      --  And restore the comment state that was saved
1783
 
1784
      Tree.Restore_And_Free (Project_Comment_State);
1785
   end Parse_Single_Project;
1786
 
1787
   -----------------------
1788
   -- Project_Name_From --
1789
   -----------------------
1790
 
1791
   function Project_Name_From
1792
     (Path_Name      : String;
1793
      Is_Config_File : Boolean) return Name_Id
1794
   is
1795
      Canonical : String (1 .. Path_Name'Length) := Path_Name;
1796
      First     : Natural := Canonical'Last;
1797
      Last      : Natural := First;
1798
      Index     : Positive;
1799
 
1800
   begin
1801
      if Current_Verbosity = High then
1802
         Write_Str ("Project_Name_From (""");
1803
         Write_Str (Canonical);
1804
         Write_Line (""")");
1805
      end if;
1806
 
1807
      --  If the path name is empty, return No_Name to indicate failure
1808
 
1809
      if First = 0 then
1810
         return No_Name;
1811
      end if;
1812
 
1813
      Canonical_Case_File_Name (Canonical);
1814
 
1815
      --  Look for the last dot in the path name
1816
 
1817
      while First > 0
1818
        and then
1819
        Canonical (First) /= '.'
1820
      loop
1821
         First := First - 1;
1822
      end loop;
1823
 
1824
      --  If we have a dot, check that it is followed by the correct extension
1825
 
1826
      if First > 0 and then Canonical (First) = '.' then
1827
         if (not Is_Config_File
1828
              and then Canonical (First .. Last) = Project_File_Extension
1829
              and then First /= 1)
1830
           or else
1831
             (Is_Config_File
1832
               and then
1833
                 Canonical (First .. Last) = Config_Project_File_Extension
1834
               and then First /= 1)
1835
         then
1836
            --  Look for the last directory separator, if any
1837
 
1838
            First := First - 1;
1839
            Last := First;
1840
            while First > 0
1841
              and then Canonical (First) /= '/'
1842
              and then Canonical (First) /= Dir_Sep
1843
            loop
1844
               First := First - 1;
1845
            end loop;
1846
 
1847
         else
1848
            --  Not the correct extension, return No_Name to indicate failure
1849
 
1850
            return No_Name;
1851
         end if;
1852
 
1853
      --  If no dot in the path name, return No_Name to indicate failure
1854
 
1855
      else
1856
         return No_Name;
1857
      end if;
1858
 
1859
      First := First + 1;
1860
 
1861
      --  If the extension is the file name, return No_Name to indicate failure
1862
 
1863
      if First > Last then
1864
         return No_Name;
1865
      end if;
1866
 
1867
      --  Put the name in lower case into Name_Buffer
1868
 
1869
      Name_Len := Last - First + 1;
1870
      Name_Buffer (1 .. Name_Len) := To_Lower (Canonical (First .. Last));
1871
 
1872
      Index := 1;
1873
 
1874
      --  Check if it is a well formed project name. Return No_Name if it is
1875
      --  ill formed.
1876
 
1877
      loop
1878
         if not Is_Letter (Name_Buffer (Index)) then
1879
            return No_Name;
1880
 
1881
         else
1882
            loop
1883
               Index := Index + 1;
1884
 
1885
               exit when Index >= Name_Len;
1886
 
1887
               if Name_Buffer (Index) = '_' then
1888
                  if Name_Buffer (Index + 1) = '_' then
1889
                     return No_Name;
1890
                  end if;
1891
               end if;
1892
 
1893
               exit when Name_Buffer (Index) = '-';
1894
 
1895
               if Name_Buffer (Index) /= '_'
1896
                 and then not Is_Alphanumeric (Name_Buffer (Index))
1897
               then
1898
                  return No_Name;
1899
               end if;
1900
 
1901
            end loop;
1902
         end if;
1903
 
1904
         if Index >= Name_Len then
1905
            if Is_Alphanumeric (Name_Buffer (Name_Len)) then
1906
 
1907
               --  All checks have succeeded. Return name in Name_Buffer
1908
 
1909
               return Name_Find;
1910
 
1911
            else
1912
               return No_Name;
1913
            end if;
1914
 
1915
         elsif Name_Buffer (Index) = '-' then
1916
            Index := Index + 1;
1917
         end if;
1918
      end loop;
1919
   end Project_Name_From;
1920
 
1921
   --------------------------
1922
   -- Project_Path_Name_Of --
1923
   --------------------------
1924
 
1925
   function Project_Path_Name_Of
1926
     (In_Tree           : Project_Node_Tree_Ref;
1927
      Project_File_Name : String;
1928
      Directory         : String) return String
1929
   is
1930
 
1931
      function Try_Path_Name (Path : String) return String_Access;
1932
      pragma Inline (Try_Path_Name);
1933
      --  Try the specified Path
1934
 
1935
      -------------------
1936
      -- Try_Path_Name --
1937
      -------------------
1938
 
1939
      function Try_Path_Name (Path : String) return String_Access is
1940
         Prj_Path : constant String := Project_Path (In_Tree);
1941
         First    : Natural;
1942
         Last     : Natural;
1943
         Result   : String_Access := null;
1944
 
1945
      begin
1946
         if Current_Verbosity = High then
1947
            Write_Str  ("   Trying ");
1948
            Write_Line (Path);
1949
         end if;
1950
 
1951
         if Is_Absolute_Path (Path) then
1952
            if Is_Regular_File (Path) then
1953
               Result := new String'(Path);
1954
            end if;
1955
 
1956
         else
1957
            --  Because we don't want to resolve symbolic links, we cannot use
1958
            --  Locate_Regular_File. So, we try each possible path
1959
            --  successively.
1960
 
1961
            First := Prj_Path'First;
1962
            while First <= Prj_Path'Last loop
1963
               while First <= Prj_Path'Last
1964
                 and then Prj_Path (First) = Path_Separator
1965
               loop
1966
                  First := First + 1;
1967
               end loop;
1968
 
1969
               exit when First > Prj_Path'Last;
1970
 
1971
               Last := First;
1972
               while Last < Prj_Path'Last
1973
                 and then Prj_Path (Last + 1) /= Path_Separator
1974
               loop
1975
                  Last := Last + 1;
1976
               end loop;
1977
 
1978
               Name_Len := 0;
1979
 
1980
               if not Is_Absolute_Path (Prj_Path (First .. Last)) then
1981
                  Add_Str_To_Name_Buffer (Get_Current_Dir);
1982
                  Add_Char_To_Name_Buffer (Directory_Separator);
1983
               end if;
1984
 
1985
               Add_Str_To_Name_Buffer (Prj_Path (First .. Last));
1986
               Add_Char_To_Name_Buffer (Directory_Separator);
1987
               Add_Str_To_Name_Buffer (Path);
1988
 
1989
               if Is_Regular_File (Name_Buffer (1 .. Name_Len)) then
1990
                  Result := new String'(Name_Buffer (1 .. Name_Len));
1991
                  exit;
1992
               end if;
1993
 
1994
               First := Last + 1;
1995
            end loop;
1996
         end if;
1997
 
1998
         return Result;
1999
      end Try_Path_Name;
2000
 
2001
      --  Local Declarations
2002
 
2003
      Result    : String_Access;
2004
      Result_Id : Path_Name_Type;
2005
      Has_Dot   : Boolean := False;
2006
      Key       : Name_Id;
2007
 
2008
   --  Start of processing for Project_Path_Name_Of
2009
 
2010
   begin
2011
      if Current_Verbosity = High then
2012
         Write_Str  ("Project_Path_Name_Of (""");
2013
         Write_Str  (Project_File_Name);
2014
         Write_Str  (""", """);
2015
         Write_Str  (Directory);
2016
         Write_Line (""");");
2017
      end if;
2018
 
2019
      --  Check the project cache
2020
 
2021
      Name_Len := Project_File_Name'Length;
2022
      Name_Buffer (1 .. Name_Len) := Project_File_Name;
2023
      Key := Name_Find;
2024
      Result_Id := Projects_Paths.Get (Key);
2025
 
2026
      if Result_Id /= No_Path then
2027
         return Get_Name_String (Result_Id);
2028
      end if;
2029
 
2030
      --  Check if Project_File_Name contains an extension (a dot before a
2031
      --  directory separator). If it is the case we do not try project file
2032
      --  with an added extension as it is not possible to have multiple dots
2033
      --  on a project file name.
2034
 
2035
      Check_Dot : for K in reverse Project_File_Name'Range loop
2036
         if Project_File_Name (K) = '.' then
2037
            Has_Dot := True;
2038
            exit Check_Dot;
2039
         end if;
2040
 
2041
         exit Check_Dot when Project_File_Name (K) = Directory_Separator
2042
           or else Project_File_Name (K) = '/';
2043
      end loop Check_Dot;
2044
 
2045
      if not Is_Absolute_Path (Project_File_Name) then
2046
 
2047
         --  First we try <directory>/<file_name>.<extension>
2048
 
2049
         if not Has_Dot then
2050
            Result := Try_Path_Name
2051
              (Directory & Directory_Separator &
2052
               Project_File_Name & Project_File_Extension);
2053
         end if;
2054
 
2055
         --  Then we try <directory>/<file_name>
2056
 
2057
         if Result = null then
2058
            Result := Try_Path_Name
2059
              (Directory & Directory_Separator & Project_File_Name);
2060
         end if;
2061
      end if;
2062
 
2063
      --  Then we try <file_name>.<extension>
2064
 
2065
      if Result = null and then not Has_Dot then
2066
         Result := Try_Path_Name (Project_File_Name & Project_File_Extension);
2067
      end if;
2068
 
2069
      --  Then we try <file_name>
2070
 
2071
      if Result = null then
2072
         Result := Try_Path_Name (Project_File_Name);
2073
      end if;
2074
 
2075
      --  If we cannot find the project file, we return an empty string
2076
 
2077
      if Result = null then
2078
         return "";
2079
 
2080
      else
2081
         declare
2082
            Final_Result : constant String :=
2083
                             GNAT.OS_Lib.Normalize_Pathname
2084
                               (Result.all,
2085
                                Directory      => Directory,
2086
                                Resolve_Links  => Opt.Follow_Links_For_Files,
2087
                                Case_Sensitive => True);
2088
         begin
2089
            Free (Result);
2090
            Name_Len := Final_Result'Length;
2091
            Name_Buffer (1 .. Name_Len) := Final_Result;
2092
            Result_Id := Name_Find;
2093
 
2094
            Projects_Paths.Set (Key, Result_Id);
2095
            return Final_Result;
2096
         end;
2097
      end if;
2098
   end Project_Path_Name_Of;
2099
 
2100
end Prj.Part;

powered by: WebSVN 2.1.0

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