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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-stable/] [gcc-4.5.1/] [gcc/] [ada/] [prj-proc.adb] - Blame information for rev 826

Details | Compare with Previous | View Log

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

powered by: WebSVN 2.1.0

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