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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [prj-proc.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 R O C                             --
6
--                                                                          --
7
--                                 B o d y                                  --
8
--                                                                          --
9
--          Copyright (C) 2001-2012, Free Software Foundation, Inc.         --
10
--                                                                          --
11
-- GNAT is free software;  you can  redistribute it  and/or modify it under --
12
-- terms of the  GNU General Public License as published  by the Free Soft- --
13
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
14
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
15
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
16
-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
17
-- for  more details.  You should have  received  a copy of the GNU General --
18
-- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
19
-- http://www.gnu.org/licenses for a complete copy of the license.          --
20
--                                                                          --
21
-- GNAT was originally developed  by the GNAT team at  New York University. --
22
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
23
--                                                                          --
24
------------------------------------------------------------------------------
25
 
26
with Err_Vars; use Err_Vars;
27
with Opt;      use Opt;
28
with Osint;    use Osint;
29
with Output;   use Output;
30
with Prj.Attr; use Prj.Attr;
31
with Prj.Env;
32
with Prj.Err;  use Prj.Err;
33
with Prj.Ext;  use Prj.Ext;
34
with Prj.Nmsc; use Prj.Nmsc;
35
with Prj.Util;
36
with Prj.Part;
37
with Snames;
38
 
39
with Ada.Strings.Fixed; use Ada.Strings.Fixed;
40
 
41
with GNAT.Case_Util; use GNAT.Case_Util;
42
with GNAT.HTable;
43
 
44
package body Prj.Proc is
45
 
46
   package Processed_Projects is new GNAT.HTable.Simple_HTable
47
     (Header_Num => Header_Num,
48
      Element    => Project_Id,
49
      No_Element => No_Project,
50
      Key        => Name_Id,
51
      Hash       => Hash,
52
      Equal      => "=");
53
   --  This hash table contains all processed projects
54
 
55
   package Unit_Htable is new GNAT.HTable.Simple_HTable
56
     (Header_Num => Header_Num,
57
      Element    => Source_Id,
58
      No_Element => No_Source,
59
      Key        => Name_Id,
60
      Hash       => Hash,
61
      Equal      => "=");
62
   --  This hash table contains all processed projects
63
 
64
   procedure Add (To_Exp : in out Name_Id; Str : Name_Id);
65
   --  Concatenate two strings and returns another string if both
66
   --  arguments are not null string.
67
 
68
   --  In the following procedures, we are expected to guess the meaning of
69
   --  the parameters from their names, this is never a good idea, comments
70
   --  should be added precisely defining every formal ???
71
 
72
   procedure Add_Attributes
73
     (Project       : Project_Id;
74
      Project_Name  : Name_Id;
75
      Project_Dir   : Name_Id;
76
      Shared        : Shared_Project_Tree_Data_Access;
77
      Decl          : in out Declarations;
78
      First         : Attribute_Node_Id;
79
      Project_Level : Boolean);
80
   --  Add all attributes, starting with First, with their default values to
81
   --  the package or project with declarations Decl.
82
 
83
   procedure Check
84
     (In_Tree   : Project_Tree_Ref;
85
      Project   : Project_Id;
86
      Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
87
      Flags     : Processing_Flags);
88
   --  Set all projects to not checked, then call Recursive_Check for the
89
   --  main project Project. Project is set to No_Project if errors occurred.
90
   --  Current_Dir is for optimization purposes, avoiding extra system calls.
91
   --  If Allow_Duplicate_Basenames, then files with the same base names are
92
   --  authorized within a project for source-based languages (never for unit
93
   --  based languages)
94
 
95
   procedure Copy_Package_Declarations
96
     (From       : Declarations;
97
      To         : in out Declarations;
98
      New_Loc    : Source_Ptr;
99
      Restricted : Boolean;
100
      Shared     : Shared_Project_Tree_Data_Access);
101
   --  Copy a package declaration From to To for a renamed package. Change the
102
   --  locations of all the attributes to New_Loc. When Restricted is
103
   --  True, do not copy attributes Body, Spec, Implementation, Specification
104
   --  and Linker_Options.
105
 
106
   function Expression
107
     (Project                : Project_Id;
108
      Shared                 : Shared_Project_Tree_Data_Access;
109
      From_Project_Node      : Project_Node_Id;
110
      From_Project_Node_Tree : Project_Node_Tree_Ref;
111
      Env                    : Prj.Tree.Environment;
112
      Pkg                    : Package_Id;
113
      First_Term             : Project_Node_Id;
114
      Kind                   : Variable_Kind) return Variable_Value;
115
   --  From N_Expression project node From_Project_Node, compute the value
116
   --  of an expression and return it as a Variable_Value.
117
 
118
   function Imported_Or_Extended_Project_From
119
     (Project   : Project_Id;
120
      With_Name : Name_Id) return Project_Id;
121
   --  Find an imported or extended project of Project whose name is With_Name
122
 
123
   function Package_From
124
     (Project   : Project_Id;
125
      Shared    : Shared_Project_Tree_Data_Access;
126
      With_Name : Name_Id) return Package_Id;
127
   --  Find the package of Project whose name is With_Name
128
 
129
   procedure Process_Declarative_Items
130
     (Project           : Project_Id;
131
      In_Tree           : Project_Tree_Ref;
132
      From_Project_Node : Project_Node_Id;
133
      Node_Tree         : Project_Node_Tree_Ref;
134
      Env               : Prj.Tree.Environment;
135
      Pkg               : Package_Id;
136
      Item              : Project_Node_Id;
137
      Child_Env         : in out Prj.Tree.Environment);
138
   --  Process declarative items starting with From_Project_Node, and put them
139
   --  in declarations Decl. This is a recursive procedure; it calls itself for
140
   --  a package declaration or a case construction.
141
   --
142
   --  Child_Env is the modified environment after seeing declarations like
143
   --  "for External(...) use" or "for Project_Path use" in aggregate projects.
144
   --  It should have been initialized first.
145
 
146
   procedure Recursive_Process
147
     (In_Tree                : Project_Tree_Ref;
148
      Project                : out Project_Id;
149
      Packages_To_Check      : String_List_Access;
150
      From_Project_Node      : Project_Node_Id;
151
      From_Project_Node_Tree : Project_Node_Tree_Ref;
152
      Env                    : in out Prj.Tree.Environment;
153
      Extended_By            : Project_Id;
154
      From_Encapsulated_Lib  : Boolean);
155
   --  Process project with node From_Project_Node in the tree. Do nothing if
156
   --  From_Project_Node is Empty_Node. If project has already been processed,
157
   --  simply return its project id. Otherwise create a new project id, mark it
158
   --  as processed, call itself recursively for all imported projects and a
159
   --  extended project, if any. Then process the declarative items of the
160
   --  project.
161
   --
162
   --  Is_Root_Project should be true only for the project that the user
163
   --  explicitly loaded. In the context of aggregate projects, only that
164
   --  project is allowed to modify the environment that will be used to load
165
   --  projects (Child_Env).
166
   --
167
   --  From_Encapsulated_Lib is true if we are parsing a project from
168
   --  encapsulated library dependencies.
169
 
170
   function Get_Attribute_Index
171
     (Tree  : Project_Node_Tree_Ref;
172
      Attr  : Project_Node_Id;
173
      Index : Name_Id) return Name_Id;
174
   --  Copy the index of the attribute into Name_Buffer, converting to lower
175
   --  case if the attribute is case-insensitive.
176
 
177
   ---------
178
   -- Add --
179
   ---------
180
 
181
   procedure Add (To_Exp : in out Name_Id; Str : Name_Id) is
182
   begin
183
      if To_Exp = No_Name or else To_Exp = Empty_String then
184
 
185
         --  To_Exp is nil or empty. The result is Str
186
 
187
         To_Exp := Str;
188
 
189
      --  If Str is nil, then do not change To_Ext
190
 
191
      elsif Str /= No_Name and then Str /= Empty_String then
192
         declare
193
            S : constant String := Get_Name_String (Str);
194
         begin
195
            Get_Name_String (To_Exp);
196
            Add_Str_To_Name_Buffer (S);
197
            To_Exp := Name_Find;
198
         end;
199
      end if;
200
   end Add;
201
 
202
   --------------------
203
   -- Add_Attributes --
204
   --------------------
205
 
206
   procedure Add_Attributes
207
     (Project       : Project_Id;
208
      Project_Name  : Name_Id;
209
      Project_Dir   : Name_Id;
210
      Shared        : Shared_Project_Tree_Data_Access;
211
      Decl          : in out Declarations;
212
      First         : Attribute_Node_Id;
213
      Project_Level : Boolean)
214
   is
215
      The_Attribute  : Attribute_Node_Id := First;
216
 
217
   begin
218
      while The_Attribute /= Empty_Attribute loop
219
         if Attribute_Kind_Of (The_Attribute) = Single then
220
            declare
221
               New_Attribute : Variable_Value;
222
 
223
            begin
224
               case Variable_Kind_Of (The_Attribute) is
225
 
226
                  --  Undefined should not happen
227
 
228
                  when Undefined =>
229
                     pragma Assert
230
                       (False, "attribute with an undefined kind");
231
                     raise Program_Error;
232
 
233
                  --  Single attributes have a default value of empty string
234
 
235
                  when Single =>
236
                     New_Attribute :=
237
                       (Project  => Project,
238
                        Kind     => Single,
239
                        Location => No_Location,
240
                        Default  => True,
241
                        Value    => Empty_String,
242
                        Index    => 0);
243
 
244
                     --  Special cases of <project>'Name and
245
                     --  <project>'Project_Dir.
246
 
247
                     if Project_Level then
248
                        if Attribute_Name_Of (The_Attribute) =
249
                          Snames.Name_Name
250
                        then
251
                           New_Attribute.Value := Project_Name;
252
 
253
                        elsif Attribute_Name_Of (The_Attribute) =
254
                          Snames.Name_Project_Dir
255
                        then
256
                           New_Attribute.Value := Project_Dir;
257
                        end if;
258
                     end if;
259
 
260
                  --  List attributes have a default value of nil list
261
 
262
                  when List =>
263
                     New_Attribute :=
264
                       (Project  => Project,
265
                        Kind     => List,
266
                        Location => No_Location,
267
                        Default  => True,
268
                        Values   => Nil_String);
269
 
270
               end case;
271
 
272
               Variable_Element_Table.Increment_Last
273
                 (Shared.Variable_Elements);
274
               Shared.Variable_Elements.Table
275
                 (Variable_Element_Table.Last (Shared.Variable_Elements)) :=
276
                 (Next  => Decl.Attributes,
277
                  Name  => Attribute_Name_Of (The_Attribute),
278
                  Value => New_Attribute);
279
               Decl.Attributes :=
280
                 Variable_Element_Table.Last
281
                   (Shared.Variable_Elements);
282
            end;
283
         end if;
284
 
285
         The_Attribute := Next_Attribute (After => The_Attribute);
286
      end loop;
287
   end Add_Attributes;
288
 
289
   -----------
290
   -- Check --
291
   -----------
292
 
293
   procedure Check
294
     (In_Tree   : Project_Tree_Ref;
295
      Project   : Project_Id;
296
      Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
297
      Flags     : Processing_Flags)
298
   is
299
   begin
300
      Process_Naming_Scheme (In_Tree, Project, Node_Tree, Flags);
301
 
302
      --  Set the Other_Part field for the units
303
 
304
      declare
305
         Source1 : Source_Id;
306
         Name    : Name_Id;
307
         Source2 : Source_Id;
308
         Iter    : Source_Iterator;
309
 
310
      begin
311
         Unit_Htable.Reset;
312
 
313
         Iter := For_Each_Source (In_Tree);
314
         loop
315
            Source1 := Prj.Element (Iter);
316
            exit when Source1 = No_Source;
317
 
318
            if Source1.Unit /= No_Unit_Index then
319
               Name := Source1.Unit.Name;
320
               Source2 := Unit_Htable.Get (Name);
321
 
322
               if Source2 = No_Source then
323
                  Unit_Htable.Set (K => Name, E => Source1);
324
               else
325
                  Unit_Htable.Remove (Name);
326
               end if;
327
            end if;
328
 
329
            Next (Iter);
330
         end loop;
331
      end;
332
   end Check;
333
 
334
   -------------------------------
335
   -- Copy_Package_Declarations --
336
   -------------------------------
337
 
338
   procedure Copy_Package_Declarations
339
     (From       : Declarations;
340
      To         : in out Declarations;
341
      New_Loc    : Source_Ptr;
342
      Restricted : Boolean;
343
      Shared     : Shared_Project_Tree_Data_Access)
344
   is
345
      V1  : Variable_Id;
346
      V2  : Variable_Id      := No_Variable;
347
      Var : Variable;
348
      A1  : Array_Id;
349
      A2  : Array_Id         := No_Array;
350
      Arr : Array_Data;
351
      E1  : Array_Element_Id;
352
      E2  : Array_Element_Id := No_Array_Element;
353
      Elm : Array_Element;
354
 
355
   begin
356
      --  To avoid references in error messages to attribute declarations in
357
      --  an original package that has been renamed, copy all the attribute
358
      --  declarations of the package and change all locations to New_Loc,
359
      --  the location of the renamed package.
360
 
361
      --  First single attributes
362
 
363
      V1 := From.Attributes;
364
      while V1 /= No_Variable loop
365
 
366
         --  Copy the attribute
367
 
368
         Var := Shared.Variable_Elements.Table (V1);
369
         V1  := Var.Next;
370
 
371
         --  Do not copy the value of attribute Linker_Options if Restricted
372
 
373
         if Restricted and then Var.Name = Snames.Name_Linker_Options then
374
            Var.Value.Values := Nil_String;
375
         end if;
376
 
377
         --  Remove the Next component
378
 
379
         Var.Next := No_Variable;
380
 
381
         --  Change the location to New_Loc
382
 
383
         Var.Value.Location := New_Loc;
384
         Variable_Element_Table.Increment_Last (Shared.Variable_Elements);
385
 
386
         --  Put in new declaration
387
 
388
         if To.Attributes = No_Variable then
389
            To.Attributes :=
390
              Variable_Element_Table.Last (Shared.Variable_Elements);
391
         else
392
            Shared.Variable_Elements.Table (V2).Next :=
393
              Variable_Element_Table.Last (Shared.Variable_Elements);
394
         end if;
395
 
396
         V2 := Variable_Element_Table.Last (Shared.Variable_Elements);
397
         Shared.Variable_Elements.Table (V2) := Var;
398
      end loop;
399
 
400
      --  Then the associated array attributes
401
 
402
      A1 := From.Arrays;
403
      while A1 /= No_Array loop
404
         Arr := Shared.Arrays.Table (A1);
405
         A1  := Arr.Next;
406
 
407
         --  Remove the Next component
408
 
409
         Arr.Next := No_Array;
410
         Array_Table.Increment_Last (Shared.Arrays);
411
 
412
         --  Create new Array declaration
413
 
414
         if To.Arrays = No_Array then
415
            To.Arrays := Array_Table.Last (Shared.Arrays);
416
         else
417
            Shared.Arrays.Table (A2).Next :=
418
              Array_Table.Last (Shared.Arrays);
419
         end if;
420
 
421
         A2 := Array_Table.Last (Shared.Arrays);
422
 
423
         --  Don't store the array as its first element has not been set yet
424
 
425
         --  Copy the array elements of the array
426
 
427
         E1 := Arr.Value;
428
         Arr.Value := No_Array_Element;
429
         while E1 /= No_Array_Element loop
430
 
431
            --  Copy the array element
432
 
433
            Elm := Shared.Array_Elements.Table (E1);
434
            E1 := Elm.Next;
435
 
436
            --  Remove the Next component
437
 
438
            Elm.Next := No_Array_Element;
439
 
440
            Elm.Restricted := Restricted;
441
 
442
            --  Change the location
443
 
444
            Elm.Value.Location := New_Loc;
445
            Array_Element_Table.Increment_Last (Shared.Array_Elements);
446
 
447
            --  Create new array element
448
 
449
            if Arr.Value = No_Array_Element then
450
               Arr.Value := Array_Element_Table.Last (Shared.Array_Elements);
451
            else
452
               Shared.Array_Elements.Table (E2).Next :=
453
                 Array_Element_Table.Last (Shared.Array_Elements);
454
            end if;
455
 
456
            E2 := Array_Element_Table.Last (Shared.Array_Elements);
457
            Shared.Array_Elements.Table (E2) := Elm;
458
         end loop;
459
 
460
         --  Finally, store the new array
461
 
462
         Shared.Arrays.Table (A2) := Arr;
463
      end loop;
464
   end Copy_Package_Declarations;
465
 
466
   -------------------------
467
   -- Get_Attribute_Index --
468
   -------------------------
469
 
470
   function Get_Attribute_Index
471
     (Tree  : Project_Node_Tree_Ref;
472
      Attr  : Project_Node_Id;
473
      Index : Name_Id) return Name_Id
474
   is
475
   begin
476
      if Index = All_Other_Names
477
        or else not Case_Insensitive (Attr, Tree)
478
      then
479
         return Index;
480
      end if;
481
 
482
      Get_Name_String (Index);
483
      To_Lower (Name_Buffer (1 .. Name_Len));
484
      return Name_Find;
485
   end Get_Attribute_Index;
486
 
487
   ----------------
488
   -- Expression --
489
   ----------------
490
 
491
   function Expression
492
     (Project                : Project_Id;
493
      Shared                 : Shared_Project_Tree_Data_Access;
494
      From_Project_Node      : Project_Node_Id;
495
      From_Project_Node_Tree : Project_Node_Tree_Ref;
496
      Env                    : Prj.Tree.Environment;
497
      Pkg                    : Package_Id;
498
      First_Term             : Project_Node_Id;
499
      Kind                   : Variable_Kind) return Variable_Value
500
   is
501
      The_Term : Project_Node_Id;
502
      --  The term in the expression list
503
 
504
      The_Current_Term : Project_Node_Id := Empty_Node;
505
      --  The current term node id
506
 
507
      Result : Variable_Value (Kind => Kind);
508
      --  The returned result
509
 
510
      Last : String_List_Id := Nil_String;
511
      --  Reference to the last string elements in Result, when Kind is List
512
 
513
   begin
514
      Result.Project := Project;
515
      Result.Location := Location_Of (First_Term, From_Project_Node_Tree);
516
 
517
      --  Process each term of the expression, starting with First_Term
518
 
519
      The_Term := First_Term;
520
      while Present (The_Term) loop
521
         The_Current_Term := Current_Term (The_Term, From_Project_Node_Tree);
522
 
523
         case Kind_Of (The_Current_Term, From_Project_Node_Tree) is
524
 
525
            when N_Literal_String =>
526
 
527
               case Kind is
528
 
529
                  when Undefined =>
530
 
531
                     --  Should never happen
532
 
533
                     pragma Assert (False, "Undefined expression kind");
534
                     raise Program_Error;
535
 
536
                  when Single =>
537
                     Add (Result.Value,
538
                          String_Value_Of
539
                            (The_Current_Term, From_Project_Node_Tree));
540
                     Result.Index :=
541
                       Source_Index_Of
542
                         (The_Current_Term, From_Project_Node_Tree);
543
 
544
                  when List =>
545
 
546
                     String_Element_Table.Increment_Last
547
                       (Shared.String_Elements);
548
 
549
                     if Last = Nil_String then
550
 
551
                        --  This can happen in an expression like () & "toto"
552
 
553
                        Result.Values := String_Element_Table.Last
554
                          (Shared.String_Elements);
555
 
556
                     else
557
                        Shared.String_Elements.Table
558
                          (Last).Next := String_Element_Table.Last
559
                                       (Shared.String_Elements);
560
                     end if;
561
 
562
                     Last := String_Element_Table.Last
563
                               (Shared.String_Elements);
564
 
565
                     Shared.String_Elements.Table (Last) :=
566
                       (Value         => String_Value_Of
567
                                           (The_Current_Term,
568
                                            From_Project_Node_Tree),
569
                        Index         => Source_Index_Of
570
                                           (The_Current_Term,
571
                                            From_Project_Node_Tree),
572
                        Display_Value => No_Name,
573
                        Location      => Location_Of
574
                                           (The_Current_Term,
575
                                            From_Project_Node_Tree),
576
                        Flag          => False,
577
                        Next          => Nil_String);
578
               end case;
579
 
580
            when N_Literal_String_List =>
581
 
582
               declare
583
                  String_Node : Project_Node_Id :=
584
                                  First_Expression_In_List
585
                                    (The_Current_Term,
586
                                     From_Project_Node_Tree);
587
 
588
                  Value : Variable_Value;
589
 
590
               begin
591
                  if Present (String_Node) then
592
 
593
                     --  If String_Node is nil, it is an empty list, there is
594
                     --  nothing to do.
595
 
596
                     Value := Expression
597
                       (Project                => Project,
598
                        Shared                 => Shared,
599
                        From_Project_Node      => From_Project_Node,
600
                        From_Project_Node_Tree => From_Project_Node_Tree,
601
                        Env                    => Env,
602
                        Pkg                    => Pkg,
603
                        First_Term             =>
604
                          Tree.First_Term
605
                            (String_Node, From_Project_Node_Tree),
606
                        Kind                   => Single);
607
                     String_Element_Table.Increment_Last
608
                       (Shared.String_Elements);
609
 
610
                     if Result.Values = Nil_String then
611
 
612
                        --  This literal string list is the first term in a
613
                        --  string list expression
614
 
615
                        Result.Values :=
616
                          String_Element_Table.Last
617
                            (Shared.String_Elements);
618
 
619
                     else
620
                        Shared.String_Elements.Table (Last).Next :=
621
                          String_Element_Table.Last (Shared.String_Elements);
622
                     end if;
623
 
624
                     Last :=
625
                       String_Element_Table.Last (Shared.String_Elements);
626
 
627
                     Shared.String_Elements.Table (Last) :=
628
                       (Value    => Value.Value,
629
                        Display_Value => No_Name,
630
                        Location => Value.Location,
631
                        Flag     => False,
632
                        Next     => Nil_String,
633
                        Index    => Value.Index);
634
 
635
                     loop
636
                        --  Add the other element of the literal string list
637
                        --  one after the other.
638
 
639
                        String_Node :=
640
                          Next_Expression_In_List
641
                            (String_Node, From_Project_Node_Tree);
642
 
643
                        exit when No (String_Node);
644
 
645
                        Value :=
646
                          Expression
647
                            (Project                => Project,
648
                             Shared                 => Shared,
649
                             From_Project_Node      => From_Project_Node,
650
                             From_Project_Node_Tree => From_Project_Node_Tree,
651
                             Env                    => Env,
652
                             Pkg                    => Pkg,
653
                             First_Term             =>
654
                               Tree.First_Term
655
                                 (String_Node, From_Project_Node_Tree),
656
                             Kind                   => Single);
657
 
658
                        String_Element_Table.Increment_Last
659
                          (Shared.String_Elements);
660
                        Shared.String_Elements.Table (Last).Next :=
661
                          String_Element_Table.Last (Shared.String_Elements);
662
                        Last := String_Element_Table.Last
663
                          (Shared.String_Elements);
664
                        Shared.String_Elements.Table (Last) :=
665
                          (Value    => Value.Value,
666
                           Display_Value => No_Name,
667
                           Location => Value.Location,
668
                           Flag     => False,
669
                           Next     => Nil_String,
670
                           Index    => Value.Index);
671
                     end loop;
672
                  end if;
673
               end;
674
 
675
            when N_Variable_Reference | N_Attribute_Reference =>
676
 
677
               declare
678
                  The_Project     : Project_Id  := Project;
679
                  The_Package     : Package_Id  := Pkg;
680
                  The_Name        : Name_Id     := No_Name;
681
                  The_Variable_Id : Variable_Id := No_Variable;
682
                  The_Variable    : Variable_Value;
683
                  Term_Project    : constant Project_Node_Id :=
684
                                      Project_Node_Of
685
                                        (The_Current_Term,
686
                                         From_Project_Node_Tree);
687
                  Term_Package    : constant Project_Node_Id :=
688
                                      Package_Node_Of
689
                                        (The_Current_Term,
690
                                         From_Project_Node_Tree);
691
                  Index           : Name_Id := No_Name;
692
 
693
               begin
694
                  if Present (Term_Project)
695
                    and then Term_Project /= From_Project_Node
696
                  then
697
                     --  This variable or attribute comes from another project
698
 
699
                     The_Name :=
700
                       Name_Of (Term_Project, From_Project_Node_Tree);
701
                     The_Project := Imported_Or_Extended_Project_From
702
                                      (Project   => Project,
703
                                       With_Name => The_Name);
704
                  end if;
705
 
706
                  if Present (Term_Package) then
707
 
708
                     --  This is an attribute of a package
709
 
710
                     The_Name :=
711
                       Name_Of (Term_Package, From_Project_Node_Tree);
712
 
713
                     The_Package := The_Project.Decl.Packages;
714
                     while The_Package /= No_Package
715
                       and then Shared.Packages.Table (The_Package).Name /=
716
                          The_Name
717
                     loop
718
                        The_Package :=
719
                          Shared.Packages.Table (The_Package).Next;
720
                     end loop;
721
 
722
                     pragma Assert
723
                       (The_Package /= No_Package, "package not found.");
724
 
725
                  elsif Kind_Of (The_Current_Term, From_Project_Node_Tree) =
726
                                                        N_Attribute_Reference
727
                  then
728
                     The_Package := No_Package;
729
                  end if;
730
 
731
                  The_Name :=
732
                    Name_Of (The_Current_Term, From_Project_Node_Tree);
733
 
734
                  if Kind_Of (The_Current_Term, From_Project_Node_Tree) =
735
                                                        N_Attribute_Reference
736
                  then
737
                     Index :=
738
                       Associative_Array_Index_Of
739
                         (The_Current_Term, From_Project_Node_Tree);
740
                  end if;
741
 
742
                  --  If it is not an associative array attribute
743
 
744
                  if Index = No_Name then
745
 
746
                     --  It is not an associative array attribute
747
 
748
                     if The_Package /= No_Package then
749
 
750
                        --  First, if there is a package, look into the package
751
 
752
                        if Kind_Of (The_Current_Term, From_Project_Node_Tree) =
753
                                                        N_Variable_Reference
754
                        then
755
                           The_Variable_Id :=
756
                             Shared.Packages.Table
757
                               (The_Package).Decl.Variables;
758
                        else
759
                           The_Variable_Id :=
760
                             Shared.Packages.Table
761
                               (The_Package).Decl.Attributes;
762
                        end if;
763
 
764
                        while The_Variable_Id /= No_Variable
765
                          and then Shared.Variable_Elements.Table
766
                                     (The_Variable_Id).Name /= The_Name
767
                        loop
768
                           The_Variable_Id :=
769
                             Shared.Variable_Elements.Table
770
                               (The_Variable_Id).Next;
771
                        end loop;
772
 
773
                     end if;
774
 
775
                     if The_Variable_Id = No_Variable then
776
 
777
                        --  If we have not found it, look into the project
778
 
779
                        if Kind_Of (The_Current_Term, From_Project_Node_Tree) =
780
                             N_Variable_Reference
781
                        then
782
                           The_Variable_Id := The_Project.Decl.Variables;
783
                        else
784
                           The_Variable_Id := The_Project.Decl.Attributes;
785
                        end if;
786
 
787
                        while The_Variable_Id /= No_Variable
788
                          and then Shared.Variable_Elements.Table
789
                            (The_Variable_Id).Name /= The_Name
790
                        loop
791
                           The_Variable_Id :=
792
                             Shared.Variable_Elements.Table
793
                               (The_Variable_Id).Next;
794
                        end loop;
795
 
796
                     end if;
797
 
798
                     pragma Assert (The_Variable_Id /= No_Variable,
799
                                      "variable or attribute not found");
800
 
801
                     The_Variable :=
802
                       Shared.Variable_Elements.Table (The_Variable_Id).Value;
803
 
804
                  else
805
 
806
                     --  It is an associative array attribute
807
 
808
                     declare
809
                        The_Array   : Array_Id := No_Array;
810
                        The_Element : Array_Element_Id := No_Array_Element;
811
                        Array_Index : Name_Id := No_Name;
812
 
813
                     begin
814
                        if The_Package /= No_Package then
815
                           The_Array :=
816
                             Shared.Packages.Table (The_Package).Decl.Arrays;
817
                        else
818
                           The_Array := The_Project.Decl.Arrays;
819
                        end if;
820
 
821
                        while The_Array /= No_Array
822
                          and then Shared.Arrays.Table (The_Array).Name /=
823
                                                                    The_Name
824
                        loop
825
                           The_Array := Shared.Arrays.Table (The_Array).Next;
826
                        end loop;
827
 
828
                        if The_Array /= No_Array then
829
                           The_Element :=
830
                             Shared.Arrays.Table (The_Array).Value;
831
                           Array_Index :=
832
                             Get_Attribute_Index
833
                               (From_Project_Node_Tree,
834
                                The_Current_Term,
835
                                Index);
836
 
837
                           while The_Element /= No_Array_Element
838
                             and then Shared.Array_Elements.Table
839
                                        (The_Element).Index /= Array_Index
840
                           loop
841
                              The_Element :=
842
                                Shared.Array_Elements.Table (The_Element).Next;
843
                           end loop;
844
 
845
                        end if;
846
 
847
                        if The_Element /= No_Array_Element then
848
                           The_Variable :=
849
                             Shared.Array_Elements.Table (The_Element).Value;
850
 
851
                        else
852
                           if Expression_Kind_Of
853
                                (The_Current_Term, From_Project_Node_Tree) =
854
                                                                        List
855
                           then
856
                              The_Variable :=
857
                                (Project  => Project,
858
                                 Kind     => List,
859
                                 Location => No_Location,
860
                                 Default  => True,
861
                                 Values   => Nil_String);
862
                           else
863
                              The_Variable :=
864
                                (Project  => Project,
865
                                 Kind     => Single,
866
                                 Location => No_Location,
867
                                 Default  => True,
868
                                 Value    => Empty_String,
869
                                 Index    => 0);
870
                           end if;
871
                        end if;
872
                     end;
873
                  end if;
874
 
875
                  case Kind is
876
 
877
                     when Undefined =>
878
 
879
                        --  Should never happen
880
 
881
                        pragma Assert (False, "undefined expression kind");
882
                        null;
883
 
884
                     when Single =>
885
 
886
                        case The_Variable.Kind is
887
 
888
                           when Undefined =>
889
                              null;
890
 
891
                           when Single =>
892
                              Add (Result.Value, The_Variable.Value);
893
 
894
                           when List =>
895
 
896
                              --  Should never happen
897
 
898
                              pragma Assert
899
                                (False,
900
                                 "list cannot appear in single " &
901
                                 "string expression");
902
                              null;
903
                        end case;
904
 
905
                     when List =>
906
                        case The_Variable.Kind is
907
 
908
                           when Undefined =>
909
                              null;
910
 
911
                           when Single =>
912
                              String_Element_Table.Increment_Last
913
                                (Shared.String_Elements);
914
 
915
                              if Last = Nil_String then
916
 
917
                                 --  This can happen in an expression such as
918
                                 --  () & Var
919
 
920
                                 Result.Values :=
921
                                   String_Element_Table.Last
922
                                     (Shared.String_Elements);
923
 
924
                              else
925
                                 Shared.String_Elements.Table (Last).Next :=
926
                                     String_Element_Table.Last
927
                                       (Shared.String_Elements);
928
                              end if;
929
 
930
                              Last :=
931
                                String_Element_Table.Last
932
                                  (Shared.String_Elements);
933
 
934
                              Shared.String_Elements.Table (Last) :=
935
                                (Value         => The_Variable.Value,
936
                                 Display_Value => No_Name,
937
                                 Location      => Location_Of
938
                                                    (The_Current_Term,
939
                                                     From_Project_Node_Tree),
940
                                 Flag          => False,
941
                                 Next          => Nil_String,
942
                                 Index         => 0);
943
 
944
                           when List =>
945
 
946
                              declare
947
                                 The_List : String_List_Id :=
948
                                              The_Variable.Values;
949
 
950
                              begin
951
                                 while The_List /= Nil_String loop
952
                                    String_Element_Table.Increment_Last
953
                                      (Shared.String_Elements);
954
 
955
                                    if Last = Nil_String then
956
                                       Result.Values :=
957
                                         String_Element_Table.Last
958
                                           (Shared.String_Elements);
959
 
960
                                    else
961
                                       Shared.
962
                                         String_Elements.Table (Last).Next :=
963
                                         String_Element_Table.Last
964
                                           (Shared.String_Elements);
965
 
966
                                    end if;
967
 
968
                                    Last :=
969
                                      String_Element_Table.Last
970
                                        (Shared.String_Elements);
971
 
972
                                    Shared.String_Elements.Table
973
                                      (Last) :=
974
                                      (Value         =>
975
                                         Shared.String_Elements.Table
976
                                           (The_List).Value,
977
                                       Display_Value => No_Name,
978
                                       Location      =>
979
                                         Location_Of
980
                                           (The_Current_Term,
981
                                            From_Project_Node_Tree),
982
                                       Flag         => False,
983
                                       Next         => Nil_String,
984
                                       Index        => 0);
985
 
986
                                    The_List := Shared.String_Elements.Table
987
                                        (The_List).Next;
988
                                 end loop;
989
                              end;
990
                        end case;
991
                  end case;
992
               end;
993
 
994
            when N_External_Value =>
995
               Get_Name_String
996
                 (String_Value_Of
997
                    (External_Reference_Of
998
                       (The_Current_Term, From_Project_Node_Tree),
999
                     From_Project_Node_Tree));
1000
 
1001
               declare
1002
                  Name     : constant Name_Id   := Name_Find;
1003
                  Default  : Name_Id            := No_Name;
1004
                  Value    : Name_Id            := No_Name;
1005
                  Ext_List : Boolean            := False;
1006
                  Str_List : String_List_Access := null;
1007
                  Def_Var  : Variable_Value;
1008
 
1009
                  Default_Node : constant Project_Node_Id :=
1010
                                   External_Default_Of
1011
                                     (The_Current_Term,
1012
                                      From_Project_Node_Tree);
1013
 
1014
               begin
1015
                  --  If there is a default value for the external reference,
1016
                  --  get its value.
1017
 
1018
                  if Present (Default_Node) then
1019
                     Def_Var := Expression
1020
                       (Project                => Project,
1021
                        Shared                 => Shared,
1022
                        From_Project_Node      => From_Project_Node,
1023
                        From_Project_Node_Tree => From_Project_Node_Tree,
1024
                        Env                    => Env,
1025
                        Pkg                    => Pkg,
1026
                        First_Term             =>
1027
                          Tree.First_Term
1028
                            (Default_Node, From_Project_Node_Tree),
1029
                        Kind                   => Single);
1030
 
1031
                     if Def_Var /= Nil_Variable_Value then
1032
                        Default := Def_Var.Value;
1033
                     end if;
1034
                  end if;
1035
 
1036
                  Ext_List := Expression_Kind_Of
1037
                                (The_Current_Term,
1038
                                 From_Project_Node_Tree) = List;
1039
 
1040
                  if Ext_List then
1041
                     Value := Prj.Ext.Value_Of (Env.External, Name, No_Name);
1042
 
1043
                     if Value /= No_Name then
1044
                        declare
1045
                           Sep   : constant String :=
1046
                                     Get_Name_String (Default);
1047
                           First : Positive := 1;
1048
                           Lst   : Natural;
1049
                           Done  : Boolean := False;
1050
                           Nmb   : Natural;
1051
 
1052
                        begin
1053
                           Get_Name_String (Value);
1054
 
1055
                           if Name_Len = 0
1056
                             or else Sep'Length = 0
1057
                             or else Name_Buffer (1 .. Name_Len) = Sep
1058
                           then
1059
                              Done := True;
1060
                           end if;
1061
 
1062
                           if not Done and then Name_Len < Sep'Length then
1063
                              Str_List :=
1064
                                new String_List'
1065
                                  (1 => new String'
1066
                                       (Name_Buffer (1 .. Name_Len)));
1067
                              Done := True;
1068
                           end if;
1069
 
1070
                           if not Done then
1071
                              if Name_Buffer (1 .. Sep'Length) = Sep then
1072
                                 First := Sep'Length + 1;
1073
                              end if;
1074
 
1075
                              if Name_Len - First + 1 >= Sep'Length
1076
                                and then
1077
                                  Name_Buffer (Name_Len - Sep'Length + 1 ..
1078
                                                   Name_Len) = Sep
1079
                              then
1080
                                 Name_Len := Name_Len - Sep'Length;
1081
                              end if;
1082
 
1083
                              if Name_Len = 0 then
1084
                                 Str_List :=
1085
                                   new String_List'(1 => new String'(""));
1086
                                 Done := True;
1087
                              end if;
1088
                           end if;
1089
 
1090
                           if not Done then
1091
 
1092
                              --  Count the number of strings
1093
 
1094
                              declare
1095
                                 Saved : constant Positive := First;
1096
 
1097
                              begin
1098
                                 Nmb := 1;
1099
                                 loop
1100
                                    Lst :=
1101
                                      Index
1102
                                        (Source  =>
1103
                                             Name_Buffer (First .. Name_Len),
1104
                                         Pattern => Sep);
1105
                                    exit when Lst = 0;
1106
                                    Nmb := Nmb + 1;
1107
                                    First := Lst + Sep'Length;
1108
                                 end loop;
1109
 
1110
                                 First := Saved;
1111
                              end;
1112
 
1113
                              Str_List := new String_List (1 .. Nmb);
1114
 
1115
                              --  Populate the string list
1116
 
1117
                              Nmb := 1;
1118
                              loop
1119
                                 Lst :=
1120
                                   Index
1121
                                     (Source  =>
1122
                                          Name_Buffer (First .. Name_Len),
1123
                                      Pattern => Sep);
1124
 
1125
                                 if Lst = 0 then
1126
                                    Str_List (Nmb) :=
1127
                                      new String'
1128
                                        (Name_Buffer (First .. Name_Len));
1129
                                    exit;
1130
 
1131
                                 else
1132
                                    Str_List (Nmb) :=
1133
                                      new String'
1134
                                        (Name_Buffer (First .. Lst - 1));
1135
                                    Nmb := Nmb + 1;
1136
                                    First := Lst + Sep'Length;
1137
                                 end if;
1138
                              end loop;
1139
                           end if;
1140
                        end;
1141
                     end if;
1142
 
1143
                  else
1144
                     --  Get the value
1145
 
1146
                     Value := Prj.Ext.Value_Of (Env.External, Name, Default);
1147
 
1148
                     if Value = No_Name then
1149
                        if not Quiet_Output then
1150
                           Error_Msg
1151
                             (Env.Flags, "?undefined external reference",
1152
                              Location_Of
1153
                                (The_Current_Term, From_Project_Node_Tree),
1154
                              Project);
1155
                        end if;
1156
 
1157
                        Value := Empty_String;
1158
                     end if;
1159
                  end if;
1160
 
1161
                  case Kind is
1162
 
1163
                     when Undefined =>
1164
                        null;
1165
 
1166
                     when Single =>
1167
                        if Ext_List then
1168
                           null; -- error
1169
 
1170
                        else
1171
                           Add (Result.Value, Value);
1172
                        end if;
1173
 
1174
                     when List =>
1175
                        if not Ext_List or else Str_List /= null then
1176
                           String_Element_Table.Increment_Last
1177
                             (Shared.String_Elements);
1178
 
1179
                           if Last = Nil_String then
1180
                              Result.Values :=
1181
                                String_Element_Table.Last
1182
                                  (Shared.String_Elements);
1183
 
1184
                           else
1185
                              Shared.String_Elements.Table (Last).Next
1186
                                := String_Element_Table.Last
1187
                                  (Shared.String_Elements);
1188
                           end if;
1189
 
1190
                           Last := String_Element_Table.Last
1191
                             (Shared.String_Elements);
1192
 
1193
                           if Ext_List then
1194
                              for Ind in Str_List'Range loop
1195
                                 Name_Len := 0;
1196
                                 Add_Str_To_Name_Buffer (Str_List (Ind).all);
1197
                                 Value := Name_Find;
1198
                                 Shared.String_Elements.Table (Last) :=
1199
                                   (Value         => Value,
1200
                                    Display_Value => No_Name,
1201
                                    Location      =>
1202
                                      Location_Of
1203
                                        (The_Current_Term,
1204
                                         From_Project_Node_Tree),
1205
                                    Flag          => False,
1206
                                    Next          => Nil_String,
1207
                                    Index         => 0);
1208
 
1209
                                 if Ind /= Str_List'Last then
1210
                                    String_Element_Table.Increment_Last
1211
                                      (Shared.String_Elements);
1212
                                    Shared.String_Elements.Table (Last).Next :=
1213
                                        String_Element_Table.Last
1214
                                          (Shared.String_Elements);
1215
                                    Last := String_Element_Table.Last
1216
                                        (Shared.String_Elements);
1217
                                 end if;
1218
                              end loop;
1219
 
1220
                           else
1221
                              Shared.String_Elements.Table (Last) :=
1222
                                (Value         => Value,
1223
                                 Display_Value => No_Name,
1224
                                 Location      =>
1225
                                   Location_Of
1226
                                     (The_Current_Term,
1227
                                      From_Project_Node_Tree),
1228
                                 Flag          => False,
1229
                                 Next          => Nil_String,
1230
                                 Index         => 0);
1231
                           end if;
1232
                        end if;
1233
                  end case;
1234
               end;
1235
 
1236
            when others =>
1237
 
1238
               --  Should never happen
1239
 
1240
               pragma Assert
1241
                 (False,
1242
                  "illegal node kind in an expression");
1243
               raise Program_Error;
1244
 
1245
         end case;
1246
 
1247
         The_Term := Next_Term (The_Term, From_Project_Node_Tree);
1248
      end loop;
1249
 
1250
      return Result;
1251
   end Expression;
1252
 
1253
   ---------------------------------------
1254
   -- Imported_Or_Extended_Project_From --
1255
   ---------------------------------------
1256
 
1257
   function Imported_Or_Extended_Project_From
1258
     (Project   : Project_Id;
1259
      With_Name : Name_Id) return Project_Id
1260
   is
1261
      List        : Project_List;
1262
      Result      : Project_Id;
1263
      Temp_Result : Project_Id;
1264
 
1265
   begin
1266
      --  First check if it is the name of an extended project
1267
 
1268
      Result := Project.Extends;
1269
      while Result /= No_Project loop
1270
         if Result.Name = With_Name then
1271
            return Result;
1272
         else
1273
            Result := Result.Extends;
1274
         end if;
1275
      end loop;
1276
 
1277
      --  Then check the name of each imported project
1278
 
1279
      Temp_Result := No_Project;
1280
      List := Project.Imported_Projects;
1281
      while List /= null loop
1282
         Result := List.Project;
1283
 
1284
         --  If the project is directly imported, then returns its ID
1285
 
1286
         if Result.Name = With_Name then
1287
            return Result;
1288
         end if;
1289
 
1290
         --  If a project extending the project is imported, then keep this
1291
         --  extending project as a possibility. It will be the returned ID
1292
         --  if the project is not imported directly.
1293
 
1294
         declare
1295
            Proj : Project_Id;
1296
 
1297
         begin
1298
            Proj := Result.Extends;
1299
            while Proj /= No_Project loop
1300
               if Proj.Name = With_Name then
1301
                  Temp_Result := Result;
1302
                  exit;
1303
               end if;
1304
 
1305
               Proj := Proj.Extends;
1306
            end loop;
1307
         end;
1308
 
1309
         List := List.Next;
1310
      end loop;
1311
 
1312
      pragma Assert (Temp_Result /= No_Project, "project not found");
1313
      return Temp_Result;
1314
   end Imported_Or_Extended_Project_From;
1315
 
1316
   ------------------
1317
   -- Package_From --
1318
   ------------------
1319
 
1320
   function Package_From
1321
     (Project   : Project_Id;
1322
      Shared    : Shared_Project_Tree_Data_Access;
1323
      With_Name : Name_Id) return Package_Id
1324
   is
1325
      Result : Package_Id := Project.Decl.Packages;
1326
 
1327
   begin
1328
      --  Check the name of each existing package of Project
1329
 
1330
      while Result /= No_Package
1331
        and then Shared.Packages.Table (Result).Name /= With_Name
1332
      loop
1333
         Result := Shared.Packages.Table (Result).Next;
1334
      end loop;
1335
 
1336
      if Result = No_Package then
1337
 
1338
         --  Should never happen
1339
 
1340
         Write_Line
1341
           ("package """ & Get_Name_String (With_Name) & """ not found");
1342
         raise Program_Error;
1343
 
1344
      else
1345
         return Result;
1346
      end if;
1347
   end Package_From;
1348
 
1349
   -------------
1350
   -- Process --
1351
   -------------
1352
 
1353
   procedure Process
1354
     (In_Tree                : Project_Tree_Ref;
1355
      Project                : out Project_Id;
1356
      Packages_To_Check      : String_List_Access;
1357
      Success                : out Boolean;
1358
      From_Project_Node      : Project_Node_Id;
1359
      From_Project_Node_Tree : Project_Node_Tree_Ref;
1360
      Env                    : in out Prj.Tree.Environment;
1361
      Reset_Tree             : Boolean := True)
1362
   is
1363
   begin
1364
      Process_Project_Tree_Phase_1
1365
        (In_Tree                => In_Tree,
1366
         Project                => Project,
1367
         Success                => Success,
1368
         From_Project_Node      => From_Project_Node,
1369
         From_Project_Node_Tree => From_Project_Node_Tree,
1370
         Env                    => Env,
1371
         Packages_To_Check      => Packages_To_Check,
1372
         Reset_Tree             => Reset_Tree);
1373
 
1374
      if Project_Qualifier_Of
1375
           (From_Project_Node, From_Project_Node_Tree) /= Configuration
1376
      then
1377
         Process_Project_Tree_Phase_2
1378
           (In_Tree                => In_Tree,
1379
            Project                => Project,
1380
            Success                => Success,
1381
            From_Project_Node      => From_Project_Node,
1382
            From_Project_Node_Tree => From_Project_Node_Tree,
1383
            Env                    => Env);
1384
      end if;
1385
   end Process;
1386
 
1387
   -------------------------------
1388
   -- Process_Declarative_Items --
1389
   -------------------------------
1390
 
1391
   procedure Process_Declarative_Items
1392
     (Project           : Project_Id;
1393
      In_Tree           : Project_Tree_Ref;
1394
      From_Project_Node : Project_Node_Id;
1395
      Node_Tree         : Project_Node_Tree_Ref;
1396
      Env               : Prj.Tree.Environment;
1397
      Pkg               : Package_Id;
1398
      Item              : Project_Node_Id;
1399
      Child_Env         : in out Prj.Tree.Environment)
1400
   is
1401
      Shared : constant Shared_Project_Tree_Data_Access := In_Tree.Shared;
1402
 
1403
      procedure Check_Or_Set_Typed_Variable
1404
        (Value       : in out Variable_Value;
1405
         Declaration : Project_Node_Id);
1406
      --  Check whether Value is valid for this typed variable declaration. If
1407
      --  it is an error, the behavior depends on the flags: either an error is
1408
      --  reported, or a warning, or nothing. In the last two cases, the value
1409
      --  of the variable is set to a valid value, replacing Value.
1410
 
1411
      procedure Process_Package_Declaration
1412
        (Current_Item : Project_Node_Id);
1413
      procedure Process_Attribute_Declaration
1414
        (Current : Project_Node_Id);
1415
      procedure Process_Case_Construction
1416
        (Current_Item : Project_Node_Id);
1417
      procedure Process_Associative_Array
1418
        (Current_Item : Project_Node_Id);
1419
      procedure Process_Expression
1420
        (Current : Project_Node_Id);
1421
      procedure Process_Expression_For_Associative_Array
1422
        (Current : Project_Node_Id;
1423
         New_Value    : Variable_Value);
1424
      procedure Process_Expression_Variable_Decl
1425
        (Current_Item : Project_Node_Id;
1426
         New_Value    : Variable_Value);
1427
      --  Process the various declarative items
1428
 
1429
      ---------------------------------
1430
      -- Check_Or_Set_Typed_Variable --
1431
      ---------------------------------
1432
 
1433
      procedure Check_Or_Set_Typed_Variable
1434
        (Value       : in out Variable_Value;
1435
         Declaration : Project_Node_Id)
1436
      is
1437
         Loc : constant Source_Ptr := Location_Of (Declaration, Node_Tree);
1438
 
1439
         Reset_Value    : Boolean := False;
1440
         Current_String : Project_Node_Id;
1441
 
1442
      begin
1443
         --  Report an error for an empty string
1444
 
1445
         if Value.Value = Empty_String then
1446
            Error_Msg_Name_1 := Name_Of (Declaration, Node_Tree);
1447
 
1448
            case Env.Flags.Allow_Invalid_External is
1449
               when Error =>
1450
                  Error_Msg
1451
                    (Env.Flags, "no value defined for %%", Loc, Project);
1452
               when Warning =>
1453
                  Reset_Value := True;
1454
                  Error_Msg
1455
                    (Env.Flags, "?no value defined for %%", Loc, Project);
1456
               when Silent =>
1457
                  Reset_Value := True;
1458
            end case;
1459
 
1460
         else
1461
            --  Loop through all the valid strings for the
1462
            --  string type and compare to the string value.
1463
 
1464
            Current_String :=
1465
              First_Literal_String
1466
                (String_Type_Of (Declaration, Node_Tree), Node_Tree);
1467
 
1468
            while Present (Current_String)
1469
              and then
1470
                String_Value_Of (Current_String, Node_Tree) /= Value.Value
1471
            loop
1472
               Current_String :=
1473
                 Next_Literal_String (Current_String, Node_Tree);
1474
            end loop;
1475
 
1476
            --  Report error if string value is not one for the string type
1477
 
1478
            if No (Current_String) then
1479
               Error_Msg_Name_1 := Value.Value;
1480
               Error_Msg_Name_2 := Name_Of (Declaration, Node_Tree);
1481
 
1482
               case Env.Flags.Allow_Invalid_External is
1483
                  when Error =>
1484
                     Error_Msg
1485
                       (Env.Flags, "value %% is illegal for typed string %%",
1486
                        Loc, Project);
1487
 
1488
                  when Warning =>
1489
                     Error_Msg
1490
                       (Env.Flags, "?value %% is illegal for typed string %%",
1491
                        Loc, Project);
1492
                     Reset_Value := True;
1493
 
1494
                  when Silent =>
1495
                     Reset_Value := True;
1496
               end case;
1497
            end if;
1498
         end if;
1499
 
1500
         if Reset_Value then
1501
            Current_String :=
1502
              First_Literal_String
1503
                (String_Type_Of (Declaration, Node_Tree), Node_Tree);
1504
            Value.Value := String_Value_Of (Current_String, Node_Tree);
1505
         end if;
1506
      end Check_Or_Set_Typed_Variable;
1507
 
1508
      ---------------------------------
1509
      -- Process_Package_Declaration --
1510
      ---------------------------------
1511
 
1512
      procedure Process_Package_Declaration
1513
        (Current_Item : Project_Node_Id)
1514
      is
1515
      begin
1516
         --  Do not process a package declaration that should be ignored
1517
 
1518
         if Expression_Kind_Of (Current_Item, Node_Tree) /= Ignored then
1519
 
1520
            --  Create the new package
1521
 
1522
            Package_Table.Increment_Last (Shared.Packages);
1523
 
1524
            declare
1525
               New_Pkg         : constant Package_Id :=
1526
                                  Package_Table.Last (Shared.Packages);
1527
               The_New_Package : Package_Element;
1528
 
1529
               Project_Of_Renamed_Package : constant Project_Node_Id :=
1530
                                              Project_Of_Renamed_Package_Of
1531
                                                (Current_Item, Node_Tree);
1532
 
1533
            begin
1534
               --  Set the name of the new package
1535
 
1536
               The_New_Package.Name := Name_Of (Current_Item, Node_Tree);
1537
 
1538
               --  Insert the new package in the appropriate list
1539
 
1540
               if Pkg /= No_Package then
1541
                  The_New_Package.Next :=
1542
                    Shared.Packages.Table (Pkg).Decl.Packages;
1543
                  Shared.Packages.Table (Pkg).Decl.Packages := New_Pkg;
1544
 
1545
               else
1546
                  The_New_Package.Next  := Project.Decl.Packages;
1547
                  Project.Decl.Packages := New_Pkg;
1548
               end if;
1549
 
1550
               Shared.Packages.Table (New_Pkg) := The_New_Package;
1551
 
1552
               if Present (Project_Of_Renamed_Package) then
1553
 
1554
                  --  Renamed or extending package
1555
 
1556
                  declare
1557
                     Project_Name : constant Name_Id :=
1558
                                      Name_Of (Project_Of_Renamed_Package,
1559
                                               Node_Tree);
1560
 
1561
                     Renamed_Project : constant Project_Id :=
1562
                                         Imported_Or_Extended_Project_From
1563
                                           (Project, Project_Name);
1564
 
1565
                     Renamed_Package : constant Package_Id :=
1566
                                         Package_From
1567
                                           (Renamed_Project, Shared,
1568
                                            Name_Of (Current_Item, Node_Tree));
1569
 
1570
                  begin
1571
                     --  For a renamed package, copy the declarations of the
1572
                     --  renamed package, but set all the locations to the
1573
                     --  location of the package name in the renaming
1574
                     --  declaration.
1575
 
1576
                     Copy_Package_Declarations
1577
                       (From       => Shared.Packages.Table
1578
                                        (Renamed_Package).Decl,
1579
                        To         => Shared.Packages.Table (New_Pkg).Decl,
1580
                        New_Loc    => Location_Of (Current_Item, Node_Tree),
1581
                        Restricted => False,
1582
                        Shared     => Shared);
1583
                  end;
1584
 
1585
               else
1586
                  --  Set the default values of the attributes
1587
 
1588
                  Add_Attributes
1589
                    (Project,
1590
                     Project.Name,
1591
                     Name_Id (Project.Directory.Name),
1592
                     Shared,
1593
                     Shared.Packages.Table (New_Pkg).Decl,
1594
                     First_Attribute_Of
1595
                       (Package_Id_Of (Current_Item, Node_Tree)),
1596
                     Project_Level => False);
1597
               end if;
1598
 
1599
               --  Process declarative items (nothing to do when the package is
1600
               --  renaming, as the first declarative item is null).
1601
 
1602
               Process_Declarative_Items
1603
                 (Project                => Project,
1604
                  In_Tree                => In_Tree,
1605
                  From_Project_Node      => From_Project_Node,
1606
                  Node_Tree              => Node_Tree,
1607
                  Env                    => Env,
1608
                  Pkg                    => New_Pkg,
1609
                  Item                   =>
1610
                    First_Declarative_Item_Of (Current_Item, Node_Tree),
1611
                  Child_Env              => Child_Env);
1612
            end;
1613
         end if;
1614
      end Process_Package_Declaration;
1615
 
1616
      -------------------------------
1617
      -- Process_Associative_Array --
1618
      -------------------------------
1619
 
1620
      procedure Process_Associative_Array
1621
        (Current_Item : Project_Node_Id)
1622
      is
1623
         Current_Item_Name : constant Name_Id :=
1624
                               Name_Of (Current_Item, Node_Tree);
1625
         --  The name of the attribute
1626
 
1627
         Current_Location  : constant Source_Ptr :=
1628
                               Location_Of (Current_Item, Node_Tree);
1629
 
1630
         New_Array : Array_Id;
1631
         --  The new associative array created
1632
 
1633
         Orig_Array : Array_Id;
1634
         --  The associative array value
1635
 
1636
         Orig_Project_Name : Name_Id := No_Name;
1637
         --  The name of the project where the associative array
1638
         --  value is.
1639
 
1640
         Orig_Project : Project_Id := No_Project;
1641
         --  The id of the project where the associative array
1642
         --  value is.
1643
 
1644
         Orig_Package_Name : Name_Id := No_Name;
1645
         --  The name of the package, if any, where the associative array value
1646
         --  is located.
1647
 
1648
         Orig_Package : Package_Id := No_Package;
1649
         --  The id of the package, if any, where the associative array value
1650
         --  is located.
1651
 
1652
         New_Element : Array_Element_Id := No_Array_Element;
1653
         --  Id of a new array element created
1654
 
1655
         Prev_Element : Array_Element_Id := No_Array_Element;
1656
         --  Last new element id created
1657
 
1658
         Orig_Element : Array_Element_Id := No_Array_Element;
1659
         --  Current array element in original associative array
1660
 
1661
         Next_Element : Array_Element_Id := No_Array_Element;
1662
         --  Id of the array element that follows the new element. This is not
1663
         --  always nil, because values for the associative array attribute may
1664
         --  already have been declared, and the array elements declared are
1665
         --  reused.
1666
 
1667
         Prj : Project_List;
1668
 
1669
      begin
1670
         --  First find if the associative array attribute already has elements
1671
         --  declared.
1672
 
1673
         if Pkg /= No_Package then
1674
            New_Array := Shared.Packages.Table (Pkg).Decl.Arrays;
1675
         else
1676
            New_Array := Project.Decl.Arrays;
1677
         end if;
1678
 
1679
         while New_Array /= No_Array
1680
           and then Shared.Arrays.Table (New_Array).Name /= Current_Item_Name
1681
         loop
1682
            New_Array := Shared.Arrays.Table (New_Array).Next;
1683
         end loop;
1684
 
1685
         --  If the attribute has never been declared add new entry in the
1686
         --  arrays of the project/package and link it.
1687
 
1688
         if New_Array = No_Array then
1689
            Array_Table.Increment_Last (Shared.Arrays);
1690
            New_Array := Array_Table.Last (Shared.Arrays);
1691
 
1692
            if Pkg /= No_Package then
1693
               Shared.Arrays.Table (New_Array) :=
1694
                 (Name     => Current_Item_Name,
1695
                  Location => Current_Location,
1696
                  Value    => No_Array_Element,
1697
                  Next     => Shared.Packages.Table (Pkg).Decl.Arrays);
1698
 
1699
               Shared.Packages.Table (Pkg).Decl.Arrays := New_Array;
1700
 
1701
            else
1702
               Shared.Arrays.Table (New_Array) :=
1703
                 (Name     => Current_Item_Name,
1704
                  Location => Current_Location,
1705
                  Value    => No_Array_Element,
1706
                  Next     => Project.Decl.Arrays);
1707
 
1708
               Project.Decl.Arrays := New_Array;
1709
            end if;
1710
         end if;
1711
 
1712
         --  Find the project where the value is declared
1713
 
1714
         Orig_Project_Name :=
1715
           Name_Of
1716
             (Associative_Project_Of (Current_Item, Node_Tree), Node_Tree);
1717
 
1718
         Prj := In_Tree.Projects;
1719
         while Prj /= null loop
1720
            if Prj.Project.Name = Orig_Project_Name then
1721
               Orig_Project := Prj.Project;
1722
               exit;
1723
            end if;
1724
            Prj := Prj.Next;
1725
         end loop;
1726
 
1727
         pragma Assert (Orig_Project /= No_Project,
1728
                        "original project not found");
1729
 
1730
         if No (Associative_Package_Of (Current_Item, Node_Tree)) then
1731
            Orig_Array := Orig_Project.Decl.Arrays;
1732
 
1733
         else
1734
            --  If in a package, find the package where the value is declared
1735
 
1736
            Orig_Package_Name :=
1737
              Name_Of
1738
                (Associative_Package_Of (Current_Item, Node_Tree), Node_Tree);
1739
 
1740
            Orig_Package := Orig_Project.Decl.Packages;
1741
            pragma Assert (Orig_Package /= No_Package,
1742
                           "original package not found");
1743
 
1744
            while Shared.Packages.Table
1745
              (Orig_Package).Name /= Orig_Package_Name
1746
            loop
1747
               Orig_Package := Shared.Packages.Table (Orig_Package).Next;
1748
               pragma Assert (Orig_Package /= No_Package,
1749
                              "original package not found");
1750
            end loop;
1751
 
1752
            Orig_Array := Shared.Packages.Table (Orig_Package).Decl.Arrays;
1753
         end if;
1754
 
1755
         --  Now look for the array
1756
 
1757
         while Orig_Array /= No_Array
1758
           and then Shared.Arrays.Table (Orig_Array).Name /= Current_Item_Name
1759
         loop
1760
            Orig_Array := Shared.Arrays.Table (Orig_Array).Next;
1761
         end loop;
1762
 
1763
         if Orig_Array = No_Array then
1764
            Error_Msg
1765
              (Env.Flags,
1766
               "associative array value not found",
1767
               Location_Of (Current_Item, Node_Tree),
1768
               Project);
1769
 
1770
         else
1771
            Orig_Element := Shared.Arrays.Table (Orig_Array).Value;
1772
 
1773
            --  Copy each array element
1774
 
1775
            while Orig_Element /= No_Array_Element loop
1776
 
1777
               --  Case of first element
1778
 
1779
               if Prev_Element = No_Array_Element then
1780
 
1781
                  --  And there is no array element declared yet, create a new
1782
                  --  first array element.
1783
 
1784
                  if Shared.Arrays.Table (New_Array).Value =
1785
                    No_Array_Element
1786
                  then
1787
                     Array_Element_Table.Increment_Last
1788
                       (Shared.Array_Elements);
1789
                     New_Element := Array_Element_Table.Last
1790
                       (Shared.Array_Elements);
1791
                     Shared.Arrays.Table (New_Array).Value := New_Element;
1792
                     Next_Element := No_Array_Element;
1793
 
1794
                     --  Otherwise, the new element is the first
1795
 
1796
                  else
1797
                     New_Element := Shared.Arrays.Table (New_Array).Value;
1798
                     Next_Element :=
1799
                       Shared.Array_Elements.Table (New_Element).Next;
1800
                  end if;
1801
 
1802
                  --  Otherwise, reuse an existing element, or create
1803
                  --  one if necessary.
1804
 
1805
               else
1806
                  Next_Element :=
1807
                    Shared.Array_Elements.Table (Prev_Element).Next;
1808
 
1809
                  if Next_Element = No_Array_Element then
1810
                     Array_Element_Table.Increment_Last
1811
                       (Shared.Array_Elements);
1812
                     New_Element := Array_Element_Table.Last
1813
                       (Shared.Array_Elements);
1814
                     Shared.Array_Elements.Table (Prev_Element).Next :=
1815
                       New_Element;
1816
 
1817
                  else
1818
                     New_Element := Next_Element;
1819
                     Next_Element :=
1820
                       Shared.Array_Elements.Table (New_Element).Next;
1821
                  end if;
1822
               end if;
1823
 
1824
               --  Copy the value of the element
1825
 
1826
               Shared.Array_Elements.Table (New_Element) :=
1827
                 Shared.Array_Elements.Table (Orig_Element);
1828
               Shared.Array_Elements.Table (New_Element).Value.Project
1829
                 := Project;
1830
 
1831
               --  Adjust the Next link
1832
 
1833
               Shared.Array_Elements.Table (New_Element).Next := Next_Element;
1834
 
1835
               --  Adjust the previous id for the next element
1836
 
1837
               Prev_Element := New_Element;
1838
 
1839
               --  Go to the next element in the original array
1840
 
1841
               Orig_Element := Shared.Array_Elements.Table (Orig_Element).Next;
1842
            end loop;
1843
 
1844
            --  Make sure that the array ends here, in case there previously a
1845
            --  greater number of elements.
1846
 
1847
            Shared.Array_Elements.Table (New_Element).Next := No_Array_Element;
1848
         end if;
1849
      end Process_Associative_Array;
1850
 
1851
      ----------------------------------------------
1852
      -- Process_Expression_For_Associative_Array --
1853
      ----------------------------------------------
1854
 
1855
      procedure Process_Expression_For_Associative_Array
1856
        (Current   : Project_Node_Id;
1857
         New_Value : Variable_Value)
1858
      is
1859
         Name             : constant Name_Id := Name_Of (Current, Node_Tree);
1860
         Current_Location : constant Source_Ptr :=
1861
                              Location_Of (Current, Node_Tree);
1862
 
1863
         Index_Name : Name_Id :=
1864
                        Associative_Array_Index_Of (Current, Node_Tree);
1865
 
1866
         Source_Index : constant Int :=
1867
                          Source_Index_Of (Current, Node_Tree);
1868
 
1869
         The_Array : Array_Id;
1870
         Elem      : Array_Element_Id := No_Array_Element;
1871
 
1872
      begin
1873
         if Index_Name /= All_Other_Names then
1874
            Index_Name := Get_Attribute_Index (Node_Tree, Current, Index_Name);
1875
         end if;
1876
 
1877
         --  Look for the array in the appropriate list
1878
 
1879
         if Pkg /= No_Package then
1880
            The_Array := Shared.Packages.Table (Pkg).Decl.Arrays;
1881
         else
1882
            The_Array := Project.Decl.Arrays;
1883
         end if;
1884
 
1885
         while The_Array /= No_Array
1886
           and then Shared.Arrays.Table (The_Array).Name /= Name
1887
         loop
1888
            The_Array := Shared.Arrays.Table (The_Array).Next;
1889
         end loop;
1890
 
1891
         --  If the array cannot be found, create a new entry in the list.
1892
         --  As The_Array_Element is initialized to No_Array_Element, a new
1893
         --  element will be created automatically later
1894
 
1895
         if The_Array = No_Array then
1896
            Array_Table.Increment_Last (Shared.Arrays);
1897
            The_Array := Array_Table.Last (Shared.Arrays);
1898
 
1899
            if Pkg /= No_Package then
1900
               Shared.Arrays.Table (The_Array) :=
1901
                 (Name     => Name,
1902
                  Location => Current_Location,
1903
                  Value    => No_Array_Element,
1904
                  Next     => Shared.Packages.Table (Pkg).Decl.Arrays);
1905
 
1906
               Shared.Packages.Table (Pkg).Decl.Arrays := The_Array;
1907
 
1908
            else
1909
               Shared.Arrays.Table (The_Array) :=
1910
                 (Name     => Name,
1911
                  Location => Current_Location,
1912
                  Value    => No_Array_Element,
1913
                  Next     => Project.Decl.Arrays);
1914
 
1915
               Project.Decl.Arrays := The_Array;
1916
            end if;
1917
 
1918
         else
1919
            Elem := Shared.Arrays.Table (The_Array).Value;
1920
         end if;
1921
 
1922
         --  Look in the list, if any, to find an element with the same index
1923
         --  and same source index.
1924
 
1925
         while Elem /= No_Array_Element
1926
           and then
1927
             (Shared.Array_Elements.Table (Elem).Index /= Index_Name
1928
               or else
1929
                 Shared.Array_Elements.Table (Elem).Src_Index /= Source_Index)
1930
         loop
1931
            Elem := Shared.Array_Elements.Table (Elem).Next;
1932
         end loop;
1933
 
1934
         --  If no such element were found, create a new one
1935
         --  and insert it in the element list, with the
1936
         --  proper value.
1937
 
1938
         if Elem = No_Array_Element then
1939
            Array_Element_Table.Increment_Last (Shared.Array_Elements);
1940
            Elem := Array_Element_Table.Last (Shared.Array_Elements);
1941
 
1942
            Shared.Array_Elements.Table
1943
              (Elem) :=
1944
              (Index                => Index_Name,
1945
               Restricted           => False,
1946
               Src_Index            => Source_Index,
1947
               Index_Case_Sensitive =>
1948
                  not Case_Insensitive (Current, Node_Tree),
1949
               Value                => New_Value,
1950
               Next                 => Shared.Arrays.Table (The_Array).Value);
1951
 
1952
            Shared.Arrays.Table (The_Array).Value := Elem;
1953
 
1954
         else
1955
            --  An element with the same index already exists, just replace its
1956
            --  value with the new one.
1957
 
1958
            Shared.Array_Elements.Table (Elem).Value := New_Value;
1959
         end if;
1960
 
1961
         if Name = Snames.Name_External then
1962
            if In_Tree.Is_Root_Tree then
1963
               Add (Child_Env.External,
1964
                    External_Name => Get_Name_String (Index_Name),
1965
                    Value         => Get_Name_String (New_Value.Value),
1966
                    Source        => From_External_Attribute);
1967
               Add (Env.External,
1968
                    External_Name => Get_Name_String (Index_Name),
1969
                    Value         => Get_Name_String (New_Value.Value),
1970
                    Source        => From_External_Attribute);
1971
            else
1972
               if Current_Verbosity = High then
1973
                  Debug_Output
1974
                    ("'for External' has no effect except in root aggregate ("
1975
                     & Get_Name_String (Index_Name) & ")", New_Value.Value);
1976
               end if;
1977
            end if;
1978
         end if;
1979
      end Process_Expression_For_Associative_Array;
1980
 
1981
      --------------------------------------
1982
      -- Process_Expression_Variable_Decl --
1983
      --------------------------------------
1984
 
1985
      procedure Process_Expression_Variable_Decl
1986
        (Current_Item : Project_Node_Id;
1987
         New_Value    : Variable_Value)
1988
      is
1989
         Name : constant Name_Id := Name_Of (Current_Item, Node_Tree);
1990
 
1991
         Is_Attribute : constant Boolean :=
1992
                          Kind_Of (Current_Item, Node_Tree) =
1993
                            N_Attribute_Declaration;
1994
 
1995
         Var  : Variable_Id := No_Variable;
1996
 
1997
      begin
1998
         --  First, find the list where to find the variable or attribute
1999
 
2000
         if Is_Attribute then
2001
            if Pkg /= No_Package then
2002
               Var := Shared.Packages.Table (Pkg).Decl.Attributes;
2003
            else
2004
               Var := Project.Decl.Attributes;
2005
            end if;
2006
 
2007
         else
2008
            if Pkg /= No_Package then
2009
               Var := Shared.Packages.Table (Pkg).Decl.Variables;
2010
            else
2011
               Var := Project.Decl.Variables;
2012
            end if;
2013
         end if;
2014
 
2015
         --  Loop through the list, to find if it has already been declared
2016
 
2017
         while Var /= No_Variable
2018
           and then Shared.Variable_Elements.Table (Var).Name /= Name
2019
         loop
2020
            Var := Shared.Variable_Elements.Table (Var).Next;
2021
         end loop;
2022
 
2023
         --  If it has not been declared, create a new entry in the list
2024
 
2025
         if Var = No_Variable then
2026
 
2027
            --  All single string attribute should already have been declared
2028
            --  with a default empty string value.
2029
 
2030
            pragma Assert
2031
              (not Is_Attribute,
2032
               "illegal attribute declaration for " & Get_Name_String (Name));
2033
 
2034
            Variable_Element_Table.Increment_Last (Shared.Variable_Elements);
2035
            Var := Variable_Element_Table.Last (Shared.Variable_Elements);
2036
 
2037
            --  Put the new variable in the appropriate list
2038
 
2039
            if Pkg /= No_Package then
2040
               Shared.Variable_Elements.Table (Var) :=
2041
                 (Next   => Shared.Packages.Table (Pkg).Decl.Variables,
2042
                  Name   => Name,
2043
                  Value  => New_Value);
2044
               Shared.Packages.Table (Pkg).Decl.Variables := Var;
2045
 
2046
            else
2047
               Shared.Variable_Elements.Table (Var) :=
2048
                 (Next   => Project.Decl.Variables,
2049
                  Name   => Name,
2050
                  Value  => New_Value);
2051
               Project.Decl.Variables := Var;
2052
            end if;
2053
 
2054
            --  If the variable/attribute has already been declared, just
2055
            --  change the value.
2056
 
2057
         else
2058
            Shared.Variable_Elements.Table (Var).Value := New_Value;
2059
         end if;
2060
 
2061
         if Is_Attribute and then Name = Snames.Name_Project_Path then
2062
            if In_Tree.Is_Root_Tree then
2063
               declare
2064
                  Val : String_List_Id := New_Value.Values;
2065
               begin
2066
                  while Val /= Nil_String loop
2067
                     Prj.Env.Add_Directories
2068
                       (Child_Env.Project_Path,
2069
                        Get_Name_String
2070
                          (Shared.String_Elements.Table (Val).Value));
2071
                     Val := Shared.String_Elements.Table (Val).Next;
2072
                  end loop;
2073
               end;
2074
 
2075
            else
2076
               if Current_Verbosity = High then
2077
                  Debug_Output
2078
                    ("'for Project_Path' has no effect except in"
2079
                     & " root aggregate");
2080
               end if;
2081
            end if;
2082
         end if;
2083
      end Process_Expression_Variable_Decl;
2084
 
2085
      ------------------------
2086
      -- Process_Expression --
2087
      ------------------------
2088
 
2089
      procedure Process_Expression (Current : Project_Node_Id) is
2090
         New_Value : Variable_Value :=
2091
                       Expression
2092
                         (Project                => Project,
2093
                          Shared                 => Shared,
2094
                          From_Project_Node      => From_Project_Node,
2095
                          From_Project_Node_Tree => Node_Tree,
2096
                          Env                    => Env,
2097
                          Pkg                    => Pkg,
2098
                          First_Term             =>
2099
                            Tree.First_Term
2100
                              (Expression_Of (Current, Node_Tree), Node_Tree),
2101
                          Kind                 =>
2102
                            Expression_Kind_Of (Current, Node_Tree));
2103
 
2104
      begin
2105
         --  Process a typed variable declaration
2106
 
2107
         if Kind_Of (Current, Node_Tree) = N_Typed_Variable_Declaration then
2108
            Check_Or_Set_Typed_Variable (New_Value, Current);
2109
         end if;
2110
 
2111
         if Kind_Of (Current, Node_Tree) /= N_Attribute_Declaration
2112
           or else Associative_Array_Index_Of (Current, Node_Tree) = No_Name
2113
         then
2114
            Process_Expression_Variable_Decl (Current, New_Value);
2115
         else
2116
            Process_Expression_For_Associative_Array (Current, New_Value);
2117
         end if;
2118
      end Process_Expression;
2119
 
2120
      -----------------------------------
2121
      -- Process_Attribute_Declaration --
2122
      -----------------------------------
2123
 
2124
      procedure Process_Attribute_Declaration (Current : Project_Node_Id) is
2125
      begin
2126
         if Expression_Of (Current, Node_Tree) = Empty_Node then
2127
            Process_Associative_Array (Current);
2128
         else
2129
            Process_Expression (Current);
2130
         end if;
2131
      end Process_Attribute_Declaration;
2132
 
2133
      -------------------------------
2134
      -- Process_Case_Construction --
2135
      -------------------------------
2136
 
2137
      procedure Process_Case_Construction
2138
        (Current_Item : Project_Node_Id)
2139
      is
2140
         The_Project : Project_Id := Project;
2141
         --  The id of the project of the case variable
2142
 
2143
         The_Package : Package_Id := Pkg;
2144
         --  The id of the package, if any, of the case variable
2145
 
2146
         The_Variable : Variable_Value := Nil_Variable_Value;
2147
         --  The case variable
2148
 
2149
         Case_Value : Name_Id := No_Name;
2150
         --  The case variable value
2151
 
2152
         Case_Item     : Project_Node_Id := Empty_Node;
2153
         Choice_String : Project_Node_Id := Empty_Node;
2154
         Decl_Item     : Project_Node_Id := Empty_Node;
2155
 
2156
      begin
2157
         declare
2158
            Variable_Node : constant Project_Node_Id :=
2159
              Case_Variable_Reference_Of
2160
                (Current_Item,
2161
                 Node_Tree);
2162
 
2163
            Var_Id : Variable_Id := No_Variable;
2164
            Name   : Name_Id     := No_Name;
2165
 
2166
         begin
2167
            --  If a project was specified for the case variable, get its id
2168
 
2169
            if Present (Project_Node_Of (Variable_Node, Node_Tree)) then
2170
               Name :=
2171
                 Name_Of
2172
                   (Project_Node_Of (Variable_Node, Node_Tree), Node_Tree);
2173
               The_Project :=
2174
                 Imported_Or_Extended_Project_From (Project, Name);
2175
            end if;
2176
 
2177
            --  If a package was specified for the case variable, get its id
2178
 
2179
            if Present (Package_Node_Of (Variable_Node, Node_Tree)) then
2180
               Name :=
2181
                 Name_Of
2182
                   (Package_Node_Of (Variable_Node, Node_Tree), Node_Tree);
2183
               The_Package := Package_From (The_Project, Shared, Name);
2184
            end if;
2185
 
2186
            Name := Name_Of (Variable_Node, Node_Tree);
2187
 
2188
            --  First, look for the case variable into the package, if any
2189
 
2190
            if The_Package /= No_Package then
2191
               Name := Name_Of (Variable_Node, Node_Tree);
2192
 
2193
               Var_Id := Shared.Packages.Table (The_Package).Decl.Variables;
2194
               while Var_Id /= No_Variable
2195
                 and then Shared.Variable_Elements.Table (Var_Id).Name /= Name
2196
               loop
2197
                  Var_Id := Shared.Variable_Elements.Table (Var_Id).Next;
2198
               end loop;
2199
            end if;
2200
 
2201
            --  If not found in the package, or if there is no package, look at
2202
            --  the project level.
2203
 
2204
            if Var_Id = No_Variable
2205
              and then No (Package_Node_Of (Variable_Node, Node_Tree))
2206
            then
2207
               Var_Id := The_Project.Decl.Variables;
2208
               while Var_Id /= No_Variable
2209
                 and then Shared.Variable_Elements.Table (Var_Id).Name /= Name
2210
               loop
2211
                  Var_Id := Shared.Variable_Elements.Table (Var_Id).Next;
2212
               end loop;
2213
            end if;
2214
 
2215
            if Var_Id = No_Variable then
2216
 
2217
               --  Should never happen, because this has already been checked
2218
               --  during parsing.
2219
 
2220
               Write_Line
2221
                 ("variable """ & Get_Name_String (Name) & """ not found");
2222
               raise Program_Error;
2223
            end if;
2224
 
2225
            --  Get the case variable
2226
 
2227
            The_Variable := Shared.Variable_Elements. Table (Var_Id).Value;
2228
 
2229
            if The_Variable.Kind /= Single then
2230
 
2231
               --  Should never happen, because this has already been checked
2232
               --  during parsing.
2233
 
2234
               Write_Line ("variable""" & Get_Name_String (Name) &
2235
                           """ is not a single string variable");
2236
               raise Program_Error;
2237
            end if;
2238
 
2239
            --  Get the case variable value
2240
 
2241
            Case_Value := The_Variable.Value;
2242
         end;
2243
 
2244
         --  Now look into all the case items of the case construction
2245
 
2246
         Case_Item := First_Case_Item_Of (Current_Item, Node_Tree);
2247
 
2248
         Case_Item_Loop :
2249
         while Present (Case_Item) loop
2250
            Choice_String := First_Choice_Of (Case_Item, Node_Tree);
2251
 
2252
            --  When Choice_String is nil, it means that it is the
2253
            --  "when others =>" alternative.
2254
 
2255
            if No (Choice_String) then
2256
               Decl_Item := First_Declarative_Item_Of (Case_Item, Node_Tree);
2257
               exit Case_Item_Loop;
2258
            end if;
2259
 
2260
            --  Look into all the alternative of this case item
2261
 
2262
            Choice_Loop :
2263
            while Present (Choice_String) loop
2264
               if Case_Value = String_Value_Of (Choice_String, Node_Tree) then
2265
                  Decl_Item :=
2266
                    First_Declarative_Item_Of (Case_Item, Node_Tree);
2267
                  exit Case_Item_Loop;
2268
               end if;
2269
 
2270
               Choice_String := Next_Literal_String (Choice_String, Node_Tree);
2271
            end loop Choice_Loop;
2272
 
2273
            Case_Item := Next_Case_Item (Case_Item, Node_Tree);
2274
         end loop Case_Item_Loop;
2275
 
2276
         --  If there is an alternative, then we process it
2277
 
2278
         if Present (Decl_Item) then
2279
            Process_Declarative_Items
2280
              (Project                => Project,
2281
               In_Tree                => In_Tree,
2282
               From_Project_Node      => From_Project_Node,
2283
               Node_Tree              => Node_Tree,
2284
               Env                    => Env,
2285
               Pkg                    => Pkg,
2286
               Item                   => Decl_Item,
2287
               Child_Env              => Child_Env);
2288
         end if;
2289
      end Process_Case_Construction;
2290
 
2291
      --  Local variables
2292
 
2293
      Current, Decl : Project_Node_Id;
2294
      Kind          : Project_Node_Kind;
2295
 
2296
   --  Start of processing for Process_Declarative_Items
2297
 
2298
   begin
2299
      Decl := Item;
2300
      while Present (Decl) loop
2301
         Current := Current_Item_Node (Decl, Node_Tree);
2302
         Decl    := Next_Declarative_Item (Decl, Node_Tree);
2303
         Kind    := Kind_Of (Current, Node_Tree);
2304
 
2305
         case Kind is
2306
            when N_Package_Declaration =>
2307
               Process_Package_Declaration (Current);
2308
 
2309
            --  Nothing to process for string type declaration
2310
 
2311
            when N_String_Type_Declaration =>
2312
               null;
2313
 
2314
            when N_Attribute_Declaration      |
2315
                 N_Typed_Variable_Declaration |
2316
                 N_Variable_Declaration       =>
2317
               Process_Attribute_Declaration (Current);
2318
 
2319
            when N_Case_Construction =>
2320
               Process_Case_Construction (Current);
2321
 
2322
            when others =>
2323
               Write_Line ("Illegal declarative item: " & Kind'Img);
2324
               raise Program_Error;
2325
         end case;
2326
      end loop;
2327
   end Process_Declarative_Items;
2328
 
2329
   ----------------------------------
2330
   -- Process_Project_Tree_Phase_1 --
2331
   ----------------------------------
2332
 
2333
   procedure Process_Project_Tree_Phase_1
2334
     (In_Tree                : Project_Tree_Ref;
2335
      Project                : out Project_Id;
2336
      Packages_To_Check      : String_List_Access;
2337
      Success                : out Boolean;
2338
      From_Project_Node      : Project_Node_Id;
2339
      From_Project_Node_Tree : Project_Node_Tree_Ref;
2340
      Env                    : in out Prj.Tree.Environment;
2341
      Reset_Tree             : Boolean := True)
2342
   is
2343
   begin
2344
      if Reset_Tree then
2345
 
2346
         --  Make sure there are no projects in the data structure
2347
 
2348
         Free_List (In_Tree.Projects, Free_Project => True);
2349
      end if;
2350
 
2351
      Processed_Projects.Reset;
2352
 
2353
      --  And process the main project and all of the projects it depends on,
2354
      --  recursively.
2355
 
2356
      Debug_Increase_Indent ("Process tree, phase 1");
2357
 
2358
      Recursive_Process
2359
        (Project                => Project,
2360
         In_Tree                => In_Tree,
2361
         Packages_To_Check      => Packages_To_Check,
2362
         From_Project_Node      => From_Project_Node,
2363
         From_Project_Node_Tree => From_Project_Node_Tree,
2364
         Env                    => Env,
2365
         Extended_By            => No_Project,
2366
         From_Encapsulated_Lib  => False);
2367
 
2368
      Success :=
2369
        Total_Errors_Detected = 0
2370
          and then
2371
          (Warning_Mode /= Treat_As_Error or else Warnings_Detected = 0);
2372
 
2373
      if Current_Verbosity = High then
2374
         Debug_Decrease_Indent
2375
           ("Done Process tree, phase 1, Success=" & Success'Img);
2376
      end if;
2377
   end Process_Project_Tree_Phase_1;
2378
 
2379
   ----------------------------------
2380
   -- Process_Project_Tree_Phase_2 --
2381
   ----------------------------------
2382
 
2383
   procedure Process_Project_Tree_Phase_2
2384
     (In_Tree                : Project_Tree_Ref;
2385
      Project                : Project_Id;
2386
      Success                : out Boolean;
2387
      From_Project_Node      : Project_Node_Id;
2388
      From_Project_Node_Tree : Project_Node_Tree_Ref;
2389
      Env                    : Environment)
2390
   is
2391
      Obj_Dir    : Path_Name_Type;
2392
      Extending  : Project_Id;
2393
      Extending2 : Project_Id;
2394
      Prj        : Project_List;
2395
 
2396
   --  Start of processing for Process_Project_Tree_Phase_2
2397
 
2398
   begin
2399
      Success := True;
2400
 
2401
      Debug_Increase_Indent ("Process tree, phase 2", Project.Name);
2402
 
2403
      if Project /= No_Project then
2404
         Check (In_Tree, Project, From_Project_Node_Tree, Env.Flags);
2405
      end if;
2406
 
2407
      --  If main project is an extending all project, set object directory of
2408
      --  all virtual extending projects to object directory of main project.
2409
 
2410
      if Project /= No_Project
2411
        and then Is_Extending_All (From_Project_Node, From_Project_Node_Tree)
2412
      then
2413
         declare
2414
            Object_Dir : constant Path_Information := Project.Object_Directory;
2415
 
2416
         begin
2417
            Prj := In_Tree.Projects;
2418
            while Prj /= null loop
2419
               if Prj.Project.Virtual then
2420
                  Prj.Project.Object_Directory := Object_Dir;
2421
               end if;
2422
 
2423
               Prj := Prj.Next;
2424
            end loop;
2425
         end;
2426
      end if;
2427
 
2428
      --  Check that no extending project shares its object directory with
2429
      --  the project(s) it extends.
2430
 
2431
      if Project /= No_Project then
2432
         Prj := In_Tree.Projects;
2433
         while Prj /= null loop
2434
            Extending := Prj.Project.Extended_By;
2435
 
2436
            if Extending /= No_Project then
2437
               Obj_Dir := Prj.Project.Object_Directory.Name;
2438
 
2439
               --  Check that a project being extended does not share its
2440
               --  object directory with any project that extends it, directly
2441
               --  or indirectly, including a virtual extending project.
2442
 
2443
               --  Start with the project directly extending it
2444
 
2445
               Extending2 := Extending;
2446
               while Extending2 /= No_Project loop
2447
                  if Has_Ada_Sources (Extending2)
2448
                    and then Extending2.Object_Directory.Name = Obj_Dir
2449
                  then
2450
                     if Extending2.Virtual then
2451
                        Error_Msg_Name_1 := Prj.Project.Display_Name;
2452
                        Error_Msg
2453
                          (Env.Flags,
2454
                           "project %% cannot be extended by a virtual" &
2455
                           " project with the same object directory",
2456
                           Prj.Project.Location, Project);
2457
 
2458
                     else
2459
                        Error_Msg_Name_1 := Extending2.Display_Name;
2460
                        Error_Msg_Name_2 := Prj.Project.Display_Name;
2461
                        Error_Msg
2462
                          (Env.Flags,
2463
                           "project %% cannot extend project %%",
2464
                           Extending2.Location, Project);
2465
                        Error_Msg
2466
                          (Env.Flags,
2467
                           "\they share the same object directory",
2468
                           Extending2.Location, Project);
2469
                     end if;
2470
                  end if;
2471
 
2472
                  --  Continue with the next extending project, if any
2473
 
2474
                  Extending2 := Extending2.Extended_By;
2475
               end loop;
2476
            end if;
2477
 
2478
            Prj := Prj.Next;
2479
         end loop;
2480
      end if;
2481
 
2482
      Debug_Decrease_Indent ("Done Process tree, phase 2");
2483
 
2484
      Success := Total_Errors_Detected = 0
2485
        and then
2486
          (Warning_Mode /= Treat_As_Error or else Warnings_Detected = 0);
2487
   end Process_Project_Tree_Phase_2;
2488
 
2489
   -----------------------
2490
   -- Recursive_Process --
2491
   -----------------------
2492
 
2493
   procedure Recursive_Process
2494
     (In_Tree                : Project_Tree_Ref;
2495
      Project                : out Project_Id;
2496
      Packages_To_Check      : String_List_Access;
2497
      From_Project_Node      : Project_Node_Id;
2498
      From_Project_Node_Tree : Project_Node_Tree_Ref;
2499
      Env                    : in out Prj.Tree.Environment;
2500
      Extended_By            : Project_Id;
2501
      From_Encapsulated_Lib  : Boolean)
2502
   is
2503
      Shared : constant Shared_Project_Tree_Data_Access := In_Tree.Shared;
2504
 
2505
      Child_Env              : Prj.Tree.Environment;
2506
      --  Only used for the root aggregate project (if any). This is left
2507
      --  uninitialized otherwise.
2508
 
2509
      procedure Process_Imported_Projects
2510
        (Imported     : in out Project_List;
2511
         Limited_With : Boolean);
2512
      --  Process imported projects. If Limited_With is True, then only
2513
      --  projects processed through a "limited with" are processed, otherwise
2514
      --  only projects imported through a standard "with" are processed.
2515
      --  Imported is the id of the last imported project.
2516
 
2517
      procedure Process_Aggregated_Projects;
2518
      --  Process all the projects aggregated in List. This does nothing if the
2519
      --  project is not an aggregate project.
2520
 
2521
      procedure Process_Extended_Project;
2522
      --  Process the extended project: inherit all packages from the extended
2523
      --  project that are not explicitly defined or renamed. Also inherit the
2524
      --  languages, if attribute Languages is not explicitly defined.
2525
 
2526
      -------------------------------
2527
      -- Process_Imported_Projects --
2528
      -------------------------------
2529
 
2530
      procedure Process_Imported_Projects
2531
        (Imported     : in out Project_List;
2532
         Limited_With : Boolean)
2533
      is
2534
         With_Clause : Project_Node_Id;
2535
         New_Project : Project_Id;
2536
         Proj_Node   : Project_Node_Id;
2537
 
2538
      begin
2539
         With_Clause :=
2540
           First_With_Clause_Of
2541
             (From_Project_Node, From_Project_Node_Tree);
2542
 
2543
         while Present (With_Clause) loop
2544
            Proj_Node :=
2545
              Non_Limited_Project_Node_Of
2546
                (With_Clause, From_Project_Node_Tree);
2547
            New_Project := No_Project;
2548
 
2549
            if (Limited_With and then No (Proj_Node))
2550
              or else (not Limited_With and then Present (Proj_Node))
2551
            then
2552
               Recursive_Process
2553
                 (In_Tree                => In_Tree,
2554
                  Project                => New_Project,
2555
                  Packages_To_Check      => Packages_To_Check,
2556
                  From_Project_Node      =>
2557
                    Project_Node_Of (With_Clause, From_Project_Node_Tree),
2558
                  From_Project_Node_Tree => From_Project_Node_Tree,
2559
                  Env                    => Env,
2560
                  Extended_By            => No_Project,
2561
                  From_Encapsulated_Lib  => From_Encapsulated_Lib);
2562
 
2563
               if Imported = null then
2564
                  Project.Imported_Projects := new Project_List_Element'
2565
                    (Project               => New_Project,
2566
                     From_Encapsulated_Lib => False,
2567
                     Next                  => null);
2568
                  Imported := Project.Imported_Projects;
2569
               else
2570
                  Imported.Next := new Project_List_Element'
2571
                    (Project               => New_Project,
2572
                     From_Encapsulated_Lib => False,
2573
                     Next                  => null);
2574
                  Imported := Imported.Next;
2575
               end if;
2576
            end if;
2577
 
2578
            With_Clause :=
2579
              Next_With_Clause_Of (With_Clause, From_Project_Node_Tree);
2580
         end loop;
2581
      end Process_Imported_Projects;
2582
 
2583
      ---------------------------------
2584
      -- Process_Aggregated_Projects --
2585
      ---------------------------------
2586
 
2587
      procedure Process_Aggregated_Projects is
2588
         List           : Aggregated_Project_List;
2589
         Loaded_Project : Prj.Tree.Project_Node_Id;
2590
         Success        : Boolean := True;
2591
         Tree           : Project_Tree_Ref;
2592
 
2593
      begin
2594
         if Project.Qualifier not in Aggregate_Project then
2595
            return;
2596
         end if;
2597
 
2598
         Debug_Increase_Indent ("Process_Aggregated_Projects", Project.Name);
2599
 
2600
         Prj.Nmsc.Process_Aggregated_Projects
2601
           (Tree      => In_Tree,
2602
            Project   => Project,
2603
            Node_Tree => From_Project_Node_Tree,
2604
            Flags     => Env.Flags);
2605
 
2606
         List := Project.Aggregated_Projects;
2607
         while Success and then List /= null loop
2608
            Prj.Part.Parse
2609
              (In_Tree           => From_Project_Node_Tree,
2610
               Project           => Loaded_Project,
2611
               Packages_To_Check => Packages_To_Check,
2612
               Project_File_Name => Get_Name_String (List.Path),
2613
               Errout_Handling   => Prj.Part.Never_Finalize,
2614
               Current_Directory => Get_Name_String (Project.Directory.Name),
2615
               Is_Config_File    => False,
2616
               Env               => Child_Env);
2617
 
2618
            Success := not Prj.Tree.No (Loaded_Project);
2619
 
2620
            if Success then
2621
               List.Tree := new Project_Tree_Data (Is_Root_Tree => False);
2622
               Prj.Initialize (List.Tree);
2623
               List.Tree.Shared := In_Tree.Shared;
2624
 
2625
               --  In aggregate library, aggregated projects are parsed using
2626
               --  the aggregate library tree.
2627
 
2628
               if Project.Qualifier = Aggregate_Library then
2629
                  Tree := In_Tree;
2630
               else
2631
                  Tree := List.Tree;
2632
               end if;
2633
 
2634
               --  We can only do the phase 1 of the processing, since we do
2635
               --  not have access to the configuration file yet (this is
2636
               --  called when doing phase 1 of the processing for the root
2637
               --  aggregate project).
2638
 
2639
               if In_Tree.Is_Root_Tree then
2640
                  Process_Project_Tree_Phase_1
2641
                    (In_Tree                => Tree,
2642
                     Project                => List.Project,
2643
                     Packages_To_Check      => Packages_To_Check,
2644
                     Success                => Success,
2645
                     From_Project_Node      => Loaded_Project,
2646
                     From_Project_Node_Tree => From_Project_Node_Tree,
2647
                     Env                    => Child_Env,
2648
                     Reset_Tree             => False);
2649
               else
2650
                  --  use the same environment as the rest of the aggregated
2651
                  --  projects, ie the one that was setup by the root aggregate
2652
                  Process_Project_Tree_Phase_1
2653
                    (In_Tree                => Tree,
2654
                     Project                => List.Project,
2655
                     Packages_To_Check      => Packages_To_Check,
2656
                     Success                => Success,
2657
                     From_Project_Node      => Loaded_Project,
2658
                     From_Project_Node_Tree => From_Project_Node_Tree,
2659
                     Env                    => Env,
2660
                     Reset_Tree             => False);
2661
               end if;
2662
 
2663
            else
2664
               Debug_Output ("Failed to parse", Name_Id (List.Path));
2665
            end if;
2666
 
2667
            List := List.Next;
2668
         end loop;
2669
 
2670
         Debug_Decrease_Indent ("Done Process_Aggregated_Projects");
2671
      end Process_Aggregated_Projects;
2672
 
2673
      ------------------------------
2674
      -- Process_Extended_Project --
2675
      ------------------------------
2676
 
2677
      procedure Process_Extended_Project is
2678
         Extended_Pkg : Package_Id;
2679
         Current_Pkg  : Package_Id;
2680
         Element      : Package_Element;
2681
         First        : constant Package_Id := Project.Decl.Packages;
2682
         Attribute1   : Variable_Id;
2683
         Attribute2   : Variable_Id;
2684
         Attr_Value1  : Variable;
2685
         Attr_Value2  : Variable;
2686
 
2687
      begin
2688
         Extended_Pkg := Project.Extends.Decl.Packages;
2689
         while Extended_Pkg /= No_Package loop
2690
            Element := Shared.Packages.Table (Extended_Pkg);
2691
 
2692
            Current_Pkg := First;
2693
            while Current_Pkg /= No_Package
2694
              and then
2695
                Shared.Packages.Table (Current_Pkg).Name /= Element.Name
2696
            loop
2697
               Current_Pkg := Shared.Packages.Table (Current_Pkg).Next;
2698
            end loop;
2699
 
2700
            if Current_Pkg = No_Package then
2701
               Package_Table.Increment_Last (Shared.Packages);
2702
               Current_Pkg := Package_Table.Last (Shared.Packages);
2703
               Shared.Packages.Table (Current_Pkg) :=
2704
                 (Name   => Element.Name,
2705
                  Decl   => No_Declarations,
2706
                  Parent => No_Package,
2707
                  Next   => Project.Decl.Packages);
2708
               Project.Decl.Packages := Current_Pkg;
2709
               Copy_Package_Declarations
2710
                 (From       => Element.Decl,
2711
                  To         => Shared.Packages.Table (Current_Pkg).Decl,
2712
                  New_Loc    => No_Location,
2713
                  Restricted => True,
2714
                  Shared     => Shared);
2715
            end if;
2716
 
2717
            Extended_Pkg := Element.Next;
2718
         end loop;
2719
 
2720
         --  Check if attribute Languages is declared in the extending project
2721
 
2722
         Attribute1 := Project.Decl.Attributes;
2723
         while Attribute1 /= No_Variable loop
2724
            Attr_Value1 := Shared.Variable_Elements. Table (Attribute1);
2725
            exit when Attr_Value1.Name = Snames.Name_Languages;
2726
            Attribute1 := Attr_Value1.Next;
2727
         end loop;
2728
 
2729
         if Attribute1 = No_Variable or else Attr_Value1.Value.Default then
2730
 
2731
            --  Attribute Languages is not declared in the extending project.
2732
            --  Check if it is declared in the project being extended.
2733
 
2734
            Attribute2 := Project.Extends.Decl.Attributes;
2735
            while Attribute2 /= No_Variable loop
2736
               Attr_Value2 := Shared.Variable_Elements.Table (Attribute2);
2737
               exit when Attr_Value2.Name = Snames.Name_Languages;
2738
               Attribute2 := Attr_Value2.Next;
2739
            end loop;
2740
 
2741
            if Attribute2 /= No_Variable
2742
              and then not Attr_Value2.Value.Default
2743
            then
2744
               --  As attribute Languages is declared in the project being
2745
               --  extended, copy its value for the extending project.
2746
 
2747
               if Attribute1 = No_Variable then
2748
                  Variable_Element_Table.Increment_Last
2749
                    (Shared.Variable_Elements);
2750
                  Attribute1 := Variable_Element_Table.Last
2751
                    (Shared.Variable_Elements);
2752
                  Attr_Value1.Next := Project.Decl.Attributes;
2753
                  Project.Decl.Attributes := Attribute1;
2754
               end if;
2755
 
2756
               Attr_Value1.Name := Snames.Name_Languages;
2757
               Attr_Value1.Value := Attr_Value2.Value;
2758
               Shared.Variable_Elements.Table (Attribute1) := Attr_Value1;
2759
            end if;
2760
         end if;
2761
      end Process_Extended_Project;
2762
 
2763
   --  Start of processing for Recursive_Process
2764
 
2765
   begin
2766
      if No (From_Project_Node) then
2767
         Project := No_Project;
2768
 
2769
      else
2770
         declare
2771
            Imported, Mark   : Project_List;
2772
            Declaration_Node : Project_Node_Id  := Empty_Node;
2773
 
2774
            Name : constant Name_Id :=
2775
                     Name_Of (From_Project_Node, From_Project_Node_Tree);
2776
 
2777
            Name_Node : constant Tree_Private_Part.Project_Name_And_Node :=
2778
                          Tree_Private_Part.Projects_Htable.Get
2779
                            (From_Project_Node_Tree.Projects_HT, Name);
2780
 
2781
         begin
2782
            Project := Processed_Projects.Get (Name);
2783
 
2784
            if Project /= No_Project then
2785
 
2786
               --  Make sure that, when a project is extended, the project id
2787
               --  of the project extending it is recorded in its data, even
2788
               --  when it has already been processed as an imported project.
2789
               --  This is for virtually extended projects.
2790
 
2791
               if Extended_By /= No_Project then
2792
                  Project.Extended_By := Extended_By;
2793
               end if;
2794
 
2795
               return;
2796
            end if;
2797
 
2798
            Project :=
2799
              new Project_Data'
2800
                (Empty_Project
2801
                  (Project_Qualifier_Of
2802
                    (From_Project_Node, From_Project_Node_Tree)));
2803
 
2804
            --  Note that at this point we do not know yet if the project has
2805
            --  been withed from an encapsulated library or not.
2806
 
2807
            In_Tree.Projects :=
2808
              new Project_List_Element'
2809
             (Project               => Project,
2810
              From_Encapsulated_Lib => False,
2811
              Next                  => In_Tree.Projects);
2812
 
2813
            --  Keep track of this point
2814
 
2815
            Mark := In_Tree.Projects;
2816
 
2817
            Processed_Projects.Set (Name, Project);
2818
 
2819
            Project.Name := Name;
2820
            Project.Display_Name := Name_Node.Display_Name;
2821
            Get_Name_String (Name);
2822
 
2823
            --  If name starts with the virtual prefix, flag the project as
2824
            --  being a virtual extending project.
2825
 
2826
            if Name_Len > Virtual_Prefix'Length
2827
              and then
2828
                Name_Buffer (1 .. Virtual_Prefix'Length) = Virtual_Prefix
2829
            then
2830
               Project.Virtual := True;
2831
            end if;
2832
 
2833
            Project.Path.Display_Name :=
2834
              Path_Name_Of (From_Project_Node, From_Project_Node_Tree);
2835
            Get_Name_String (Project.Path.Display_Name);
2836
            Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
2837
            Project.Path.Name := Name_Find;
2838
 
2839
            Project.Location :=
2840
              Location_Of (From_Project_Node, From_Project_Node_Tree);
2841
 
2842
            Project.Directory.Display_Name :=
2843
              Directory_Of (From_Project_Node, From_Project_Node_Tree);
2844
            Get_Name_String (Project.Directory.Display_Name);
2845
            Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
2846
            Project.Directory.Name := Name_Find;
2847
 
2848
            Project.Extended_By := Extended_By;
2849
 
2850
            Add_Attributes
2851
              (Project,
2852
               Name,
2853
               Name_Id (Project.Directory.Name),
2854
               In_Tree.Shared,
2855
               Project.Decl,
2856
               Prj.Attr.Attribute_First,
2857
               Project_Level => True);
2858
 
2859
            Process_Imported_Projects (Imported, Limited_With => False);
2860
 
2861
            if Project.Qualifier = Aggregate and then In_Tree.Is_Root_Tree then
2862
               Initialize_And_Copy (Child_Env, Copy_From => Env);
2863
 
2864
            elsif Project.Qualifier = Aggregate_Library then
2865
 
2866
               --  The child environment is the same as the current one
2867
 
2868
               Child_Env := Env;
2869
 
2870
            else
2871
               --  No need to initialize Child_Env, since it will not be
2872
               --  used anyway by Process_Declarative_Items (only the root
2873
               --  aggregate can modify it, and it is never read anyway).
2874
 
2875
               null;
2876
            end if;
2877
 
2878
            Declaration_Node :=
2879
              Project_Declaration_Of
2880
                (From_Project_Node, From_Project_Node_Tree);
2881
 
2882
            Recursive_Process
2883
              (In_Tree                => In_Tree,
2884
               Project                => Project.Extends,
2885
               Packages_To_Check      => Packages_To_Check,
2886
               From_Project_Node      =>
2887
                 Extended_Project_Of
2888
                   (Declaration_Node, From_Project_Node_Tree),
2889
               From_Project_Node_Tree => From_Project_Node_Tree,
2890
               Env                    => Env,
2891
               Extended_By            => Project,
2892
               From_Encapsulated_Lib  => From_Encapsulated_Lib);
2893
 
2894
            Process_Declarative_Items
2895
              (Project                => Project,
2896
               In_Tree                => In_Tree,
2897
               From_Project_Node      => From_Project_Node,
2898
               Node_Tree              => From_Project_Node_Tree,
2899
               Env                    => Env,
2900
               Pkg                    => No_Package,
2901
               Item                   => First_Declarative_Item_Of
2902
                 (Declaration_Node, From_Project_Node_Tree),
2903
               Child_Env              => Child_Env);
2904
 
2905
            if Project.Extends /= No_Project then
2906
               Process_Extended_Project;
2907
            end if;
2908
 
2909
            Process_Imported_Projects (Imported, Limited_With => True);
2910
 
2911
            if Err_Vars.Total_Errors_Detected = 0 then
2912
               Process_Aggregated_Projects;
2913
            end if;
2914
 
2915
            --  At this point (after Process_Declarative_Items) we have the
2916
            --  attribute values set, we can backtrace In_Tree.Project and
2917
            --  set the From_Encapsulated_Library status.
2918
 
2919
            declare
2920
               Lib_Standalone  : constant Prj.Variable_Value :=
2921
                                   Prj.Util.Value_Of
2922
                                     (Snames.Name_Library_Standalone,
2923
                                      Project.Decl.Attributes,
2924
                                      Shared);
2925
               List            : Project_List := In_Tree.Projects;
2926
               Is_Encapsulated : Boolean;
2927
 
2928
            begin
2929
               Get_Name_String (Lib_Standalone.Value);
2930
               To_Lower (Name_Buffer (1 .. Name_Len));
2931
 
2932
               Is_Encapsulated := Name_Buffer (1 .. Name_Len) = "encapsulated";
2933
 
2934
               if Is_Encapsulated then
2935
                  while List /= null and then List /= Mark loop
2936
                     List.From_Encapsulated_Lib := Is_Encapsulated;
2937
                     List := List.Next;
2938
                  end loop;
2939
               end if;
2940
 
2941
               if Err_Vars.Total_Errors_Detected = 0 then
2942
 
2943
                  --  For an aggregate library we add the aggregated projects
2944
                  --  as imported ones. This is necessary to give visibility
2945
                  --  to all sources from the aggregates from the aggregated
2946
                  --  library projects.
2947
 
2948
                  if Project.Qualifier = Aggregate_Library then
2949
                     declare
2950
                        L : Aggregated_Project_List;
2951
                     begin
2952
                        L := Project.Aggregated_Projects;
2953
                        while L /= null loop
2954
                           Project.Imported_Projects :=
2955
                             new Project_List_Element'
2956
                               (Project               => L.Project,
2957
                                From_Encapsulated_Lib => Is_Encapsulated,
2958
                                Next                  =>
2959
                                  Project.Imported_Projects);
2960
                           L := L.Next;
2961
                        end loop;
2962
                     end;
2963
                  end if;
2964
               end if;
2965
            end;
2966
 
2967
            if Project.Qualifier = Aggregate and then In_Tree.Is_Root_Tree then
2968
               Free (Child_Env);
2969
            end if;
2970
         end;
2971
      end if;
2972
   end Recursive_Process;
2973
 
2974
end Prj.Proc;

powered by: WebSVN 2.1.0

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