OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [prj-part.adb] - Blame information for rev 706

Details | Compare with Previous | View Log

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

powered by: WebSVN 2.1.0

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