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

Subversion Repositories openrisc_2011-10-31

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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 281 jeremybenn
------------------------------------------------------------------------------
2
--                                                                          --
3
--                         GNAT COMPILER COMPONENTS                         --
4
--                                                                          --
5
--                             P R J . M A K R                              --
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 Csets;
27
with Opt;
28
with Output;
29
with Osint;    use Osint;
30
with Prj;      use Prj;
31
with Prj.Com;
32
with Prj.Part;
33
with Prj.PP;
34
with Prj.Tree; use Prj.Tree;
35
with Prj.Util; use Prj.Util;
36
with Snames;   use Snames;
37
with Table;    use Table;
38
 
39
with Ada.Characters.Handling;   use Ada.Characters.Handling;
40
with GNAT.Directory_Operations; use GNAT.Directory_Operations;
41
 
42
with System.Case_Util; use System.Case_Util;
43
with System.CRTL;
44
with System.HTable;
45
 
46
package body Prj.Makr is
47
 
48
   --  Packages of project files where unknown attributes are errors
49
 
50
   --  All the following need comments ??? All global variables and
51
   --  subprograms must be fully commented.
52
 
53
   Very_Verbose : Boolean := False;
54
   --  Set in call to Initialize to indicate very verbose output
55
 
56
   Project_File : Boolean := False;
57
   --  True when gnatname is creating/modifying a project file. False when
58
   --  gnatname is creating a configuration pragmas file.
59
 
60
   Tree : constant Project_Node_Tree_Ref := new Project_Node_Tree_Data;
61
   --  The project tree where the project file is parsed
62
 
63
   Args : Argument_List_Access;
64
   --  The list of arguments for calls to the compiler to get the unit names
65
   --  and kinds (spec or body) in the Ada sources.
66
 
67
   Path_Name : String_Access;
68
 
69
   Path_Last : Natural;
70
 
71
   Directory_Last    : Natural := 0;
72
 
73
   Output_Name      : String_Access;
74
   Output_Name_Last : Natural;
75
   Output_Name_Id   : Name_Id;
76
 
77
   Project_Naming_File_Name : String_Access;
78
   --  String (1 .. Output_Name'Length +  Naming_File_Suffix'Length);
79
 
80
   Project_Naming_Last : Natural;
81
   Project_Naming_Id   : Name_Id := No_Name;
82
 
83
   Source_List_Path : String_Access;
84
   --  (1 .. Output_Name'Length + Source_List_File_Suffix'Length);
85
   Source_List_Last : Natural;
86
 
87
   Source_List_FD : File_Descriptor;
88
 
89
   Project_Node        : Project_Node_Id := Empty_Node;
90
   Project_Declaration : Project_Node_Id := Empty_Node;
91
   Source_Dirs_List    : Project_Node_Id := Empty_Node;
92
 
93
   Project_Naming_Node     : Project_Node_Id := Empty_Node;
94
   Project_Naming_Decl     : Project_Node_Id := Empty_Node;
95
   Naming_Package          : Project_Node_Id := Empty_Node;
96
   Naming_Package_Comments : Project_Node_Id := Empty_Node;
97
 
98
   Source_Files_Comments     : Project_Node_Id := Empty_Node;
99
   Source_Dirs_Comments      : Project_Node_Id := Empty_Node;
100
   Source_List_File_Comments : Project_Node_Id := Empty_Node;
101
 
102
   Naming_String : aliased String := "naming";
103
 
104
   Gnatname_Packages : aliased String_List := (1 => Naming_String'Access);
105
 
106
   Packages_To_Check_By_Gnatname : constant String_List_Access :=
107
                                     Gnatname_Packages'Access;
108
 
109
   function Dup (Fd : File_Descriptor) return File_Descriptor;
110
 
111
   procedure Dup2 (Old_Fd, New_Fd : File_Descriptor);
112
 
113
   Gcc      : constant String := "gcc";
114
   Gcc_Path : String_Access := null;
115
 
116
   Non_Empty_Node : constant Project_Node_Id := 1;
117
   --  Used for the With_Clause of the naming project
118
 
119
   type Matched_Type is (True, False, Excluded);
120
 
121
   Naming_File_Suffix      : constant String := "_naming";
122
   Source_List_File_Suffix : constant String := "_source_list.txt";
123
 
124
   Output_FD : File_Descriptor;
125
   --  To save the project file and its naming project file
126
 
127
   procedure Write_Eol;
128
   --  Output an empty line
129
 
130
   procedure Write_A_Char (C : Character);
131
   --  Write one character to Output_FD
132
 
133
   procedure Write_A_String (S : String);
134
   --  Write a String to Output_FD
135
 
136
   package Processed_Directories is new Table.Table
137
     (Table_Component_Type => String_Access,
138
      Table_Index_Type     => Natural,
139
      Table_Low_Bound      => 0,
140
      Table_Initial        => 10,
141
      Table_Increment      => 100,
142
      Table_Name           => "Prj.Makr.Processed_Directories");
143
   --  The list of already processed directories for each section, to avoid
144
   --  processing several times the same directory in the same section.
145
 
146
   package Source_Directories is new Table.Table
147
     (Table_Component_Type => String_Access,
148
      Table_Index_Type     => Natural,
149
      Table_Low_Bound      => 0,
150
      Table_Initial        => 10,
151
      Table_Increment      => 100,
152
      Table_Name           => "Prj.Makr.Source_Directories");
153
   --  The complete list of directories to be put in attribute Source_Dirs in
154
   --  the project file.
155
 
156
   type Source is record
157
      File_Name : Name_Id;
158
      Unit_Name : Name_Id;
159
      Index     : Int := 0;
160
      Spec      : Boolean;
161
   end record;
162
 
163
   package Sources is new Table.Table
164
     (Table_Component_Type => Source,
165
      Table_Index_Type     => Natural,
166
      Table_Low_Bound      => 0,
167
      Table_Initial        => 10,
168
      Table_Increment      => 100,
169
      Table_Name           => "Prj.Makr.Sources");
170
   --  The list of Ada sources found, with their unit name and kind, to be put
171
   --  in the source attribute and package Naming of the project file, or in
172
   --  the pragmas Source_File_Name in the configuration pragmas file.
173
 
174
   package Source_Files is new System.HTable.Simple_HTable
175
     (Header_Num => Prj.Header_Num,
176
      Element    => Boolean,
177
      No_Element => False,
178
      Key        => Name_Id,
179
      Hash       => Prj.Hash,
180
      Equal      => "=");
181
   --  Hash table to keep track of source file names, to avoid putting several
182
   --  times the same file name in case of multi-unit files.
183
 
184
   ---------
185
   -- Dup --
186
   ---------
187
 
188
   function Dup  (Fd : File_Descriptor) return File_Descriptor is
189
   begin
190
      return File_Descriptor (System.CRTL.dup (Integer (Fd)));
191
   end Dup;
192
 
193
   ----------
194
   -- Dup2 --
195
   ----------
196
 
197
   procedure Dup2 (Old_Fd, New_Fd : File_Descriptor) is
198
      Fd : Integer;
199
      pragma Warnings (Off, Fd);
200
   begin
201
      Fd := System.CRTL.dup2 (Integer (Old_Fd), Integer (New_Fd));
202
   end Dup2;
203
 
204
   --------------
205
   -- Finalize --
206
   --------------
207
 
208
   procedure Finalize is
209
      Discard : Boolean;
210
      pragma Warnings (Off, Discard);
211
 
212
      Current_Source_Dir : Project_Node_Id := Empty_Node;
213
 
214
   begin
215
      if Project_File then
216
         --  If there were no already existing project file, or if the parsing
217
         --  was unsuccessful, create an empty project node with the correct
218
         --  name and its project declaration node.
219
 
220
         if No (Project_Node) then
221
            Project_Node :=
222
              Default_Project_Node (Of_Kind => N_Project, In_Tree => Tree);
223
            Set_Name_Of (Project_Node, Tree, To => Output_Name_Id);
224
            Set_Project_Declaration_Of
225
              (Project_Node, Tree,
226
               To => Default_Project_Node
227
                 (Of_Kind => N_Project_Declaration, In_Tree => Tree));
228
 
229
         end if;
230
 
231
      end if;
232
 
233
      --  Delete the file if it already exists
234
 
235
      Delete_File
236
        (Path_Name (Directory_Last + 1 .. Path_Last),
237
         Success => Discard);
238
 
239
      --  Create a new one
240
 
241
      if Opt.Verbose_Mode then
242
         Output.Write_Str ("Creating new file """);
243
         Output.Write_Str (Path_Name (Directory_Last + 1 .. Path_Last));
244
         Output.Write_Line ("""");
245
      end if;
246
 
247
      Output_FD := Create_New_File
248
        (Path_Name (Directory_Last + 1 .. Path_Last),
249
         Fmode => Text);
250
 
251
      --  Fails if project file cannot be created
252
 
253
      if Output_FD = Invalid_FD then
254
         Prj.Com.Fail
255
           ("cannot create new """ & Path_Name (1 .. Path_Last) & """");
256
      end if;
257
 
258
      if Project_File then
259
 
260
         --  Delete the source list file, if it already exists
261
 
262
         declare
263
            Discard : Boolean;
264
            pragma Warnings (Off, Discard);
265
         begin
266
            Delete_File
267
              (Source_List_Path (1 .. Source_List_Last),
268
               Success => Discard);
269
         end;
270
 
271
         --  And create a new source list file, fail if file cannot be created
272
 
273
         Source_List_FD := Create_New_File
274
           (Name  => Source_List_Path (1 .. Source_List_Last),
275
            Fmode => Text);
276
 
277
         if Source_List_FD = Invalid_FD then
278
            Prj.Com.Fail
279
              ("cannot create file """
280
               & Source_List_Path (1 .. Source_List_Last)
281
               & """");
282
         end if;
283
 
284
         if Opt.Verbose_Mode then
285
            Output.Write_Str ("Naming project file name is """);
286
            Output.Write_Str
287
              (Project_Naming_File_Name (1 .. Project_Naming_Last));
288
            Output.Write_Line ("""");
289
         end if;
290
 
291
         --  Create the naming project node
292
 
293
         Project_Naming_Node :=
294
           Default_Project_Node (Of_Kind => N_Project, In_Tree => Tree);
295
         Set_Name_Of (Project_Naming_Node, Tree, To => Project_Naming_Id);
296
         Project_Naming_Decl :=
297
           Default_Project_Node
298
             (Of_Kind => N_Project_Declaration, In_Tree => Tree);
299
         Set_Project_Declaration_Of
300
           (Project_Naming_Node, Tree, Project_Naming_Decl);
301
         Naming_Package :=
302
           Default_Project_Node
303
             (Of_Kind => N_Package_Declaration, In_Tree => Tree);
304
         Set_Name_Of (Naming_Package, Tree, To => Name_Naming);
305
 
306
         --  Add an attribute declaration for Source_Files as an empty list (to
307
         --  indicate there are no sources in the naming project) and a package
308
         --  Naming (that will be filled later).
309
 
310
         declare
311
            Decl_Item : constant Project_Node_Id :=
312
                          Default_Project_Node
313
                            (Of_Kind => N_Declarative_Item, In_Tree => Tree);
314
 
315
            Attribute : constant Project_Node_Id :=
316
                          Default_Project_Node
317
                            (Of_Kind       => N_Attribute_Declaration,
318
                             In_Tree       => Tree,
319
                             And_Expr_Kind => List);
320
 
321
            Expression : constant Project_Node_Id :=
322
                           Default_Project_Node
323
                             (Of_Kind       => N_Expression,
324
                              In_Tree       => Tree,
325
                              And_Expr_Kind => List);
326
 
327
            Term      : constant Project_Node_Id :=
328
                          Default_Project_Node
329
                            (Of_Kind       => N_Term,
330
                             In_Tree       => Tree,
331
                             And_Expr_Kind => List);
332
 
333
            Empty_List : constant Project_Node_Id :=
334
                           Default_Project_Node
335
                             (Of_Kind => N_Literal_String_List,
336
                              In_Tree => Tree);
337
 
338
         begin
339
            Set_First_Declarative_Item_Of
340
              (Project_Naming_Decl, Tree, To => Decl_Item);
341
            Set_Next_Declarative_Item (Decl_Item, Tree, Naming_Package);
342
            Set_Current_Item_Node (Decl_Item, Tree, To => Attribute);
343
            Set_Name_Of (Attribute, Tree, To => Name_Source_Files);
344
            Set_Expression_Of (Attribute, Tree, To => Expression);
345
            Set_First_Term (Expression, Tree, To => Term);
346
            Set_Current_Term (Term, Tree, To => Empty_List);
347
         end;
348
 
349
         --  Add a with clause on the naming project in the main project, if
350
         --  there is not already one.
351
 
352
         declare
353
            With_Clause : Project_Node_Id :=
354
                                  First_With_Clause_Of (Project_Node, Tree);
355
 
356
         begin
357
            while Present (With_Clause) loop
358
               exit when
359
                 Prj.Tree.Name_Of (With_Clause, Tree) = Project_Naming_Id;
360
               With_Clause := Next_With_Clause_Of (With_Clause, Tree);
361
            end loop;
362
 
363
            if No (With_Clause) then
364
               With_Clause := Default_Project_Node
365
                 (Of_Kind => N_With_Clause, In_Tree => Tree);
366
               Set_Next_With_Clause_Of
367
                 (With_Clause, Tree,
368
                  To => First_With_Clause_Of (Project_Node, Tree));
369
               Set_First_With_Clause_Of
370
                 (Project_Node, Tree, To => With_Clause);
371
               Set_Name_Of (With_Clause, Tree, To => Project_Naming_Id);
372
 
373
               --  We set the project node to something different than
374
               --  Empty_Node, so that Prj.PP does not generate a limited
375
               --  with clause.
376
 
377
               Set_Project_Node_Of (With_Clause, Tree, Non_Empty_Node);
378
 
379
               Name_Len := Project_Naming_Last;
380
               Name_Buffer (1 .. Name_Len) :=
381
                 Project_Naming_File_Name (1 .. Project_Naming_Last);
382
               Set_String_Value_Of (With_Clause, Tree, To => Name_Find);
383
            end if;
384
         end;
385
 
386
         Project_Declaration := Project_Declaration_Of (Project_Node, Tree);
387
 
388
         --  Add a package Naming in the main project, that is a renaming of
389
         --  package Naming in the naming project.
390
 
391
         declare
392
            Decl_Item  : constant Project_Node_Id :=
393
                           Default_Project_Node
394
                             (Of_Kind => N_Declarative_Item,
395
                              In_Tree => Tree);
396
 
397
            Naming : constant Project_Node_Id :=
398
                           Default_Project_Node
399
                             (Of_Kind => N_Package_Declaration,
400
                              In_Tree => Tree);
401
 
402
         begin
403
            Set_Next_Declarative_Item
404
              (Decl_Item, Tree,
405
               To => First_Declarative_Item_Of (Project_Declaration, Tree));
406
            Set_First_Declarative_Item_Of
407
              (Project_Declaration, Tree, To => Decl_Item);
408
            Set_Current_Item_Node (Decl_Item, Tree, To => Naming);
409
            Set_Name_Of (Naming, Tree, To => Name_Naming);
410
            Set_Project_Of_Renamed_Package_Of
411
              (Naming, Tree, To => Project_Naming_Node);
412
 
413
            --  Attach the comments, if any, that were saved for package
414
            --  Naming.
415
 
416
            Tree.Project_Nodes.Table (Naming).Comments :=
417
              Naming_Package_Comments;
418
         end;
419
 
420
         --  Add an attribute declaration for Source_Dirs, initialized as an
421
         --  empty list.
422
 
423
         declare
424
            Decl_Item  : constant Project_Node_Id :=
425
                           Default_Project_Node
426
                             (Of_Kind => N_Declarative_Item,
427
                              In_Tree => Tree);
428
 
429
            Attribute : constant Project_Node_Id :=
430
                           Default_Project_Node
431
                             (Of_Kind       => N_Attribute_Declaration,
432
                              In_Tree       => Tree,
433
                              And_Expr_Kind => List);
434
 
435
            Expression : constant Project_Node_Id :=
436
                           Default_Project_Node
437
                             (Of_Kind       => N_Expression,
438
                              In_Tree       => Tree,
439
                              And_Expr_Kind => List);
440
 
441
            Term  : constant Project_Node_Id :=
442
                           Default_Project_Node
443
                             (Of_Kind       => N_Term, In_Tree => Tree,
444
                              And_Expr_Kind => List);
445
 
446
         begin
447
            Set_Next_Declarative_Item
448
              (Decl_Item, Tree,
449
               To => First_Declarative_Item_Of (Project_Declaration, Tree));
450
            Set_First_Declarative_Item_Of
451
              (Project_Declaration, Tree, To => Decl_Item);
452
            Set_Current_Item_Node (Decl_Item, Tree, To => Attribute);
453
            Set_Name_Of (Attribute, Tree, To => Name_Source_Dirs);
454
            Set_Expression_Of (Attribute, Tree, To => Expression);
455
            Set_First_Term (Expression, Tree, To => Term);
456
            Source_Dirs_List :=
457
              Default_Project_Node
458
                (Of_Kind       => N_Literal_String_List,
459
                 In_Tree       => Tree,
460
                 And_Expr_Kind => List);
461
            Set_Current_Term (Term, Tree, To => Source_Dirs_List);
462
 
463
            --  Attach the comments, if any, that were saved for attribute
464
            --  Source_Dirs.
465
 
466
            Tree.Project_Nodes.Table (Attribute).Comments :=
467
              Source_Dirs_Comments;
468
         end;
469
 
470
         --  Put the source directories in attribute Source_Dirs
471
 
472
         for Source_Dir_Index in 1 .. Source_Directories.Last loop
473
            declare
474
               Expression : constant Project_Node_Id :=
475
                              Default_Project_Node
476
                                (Of_Kind       => N_Expression,
477
                                 In_Tree       => Tree,
478
                                 And_Expr_Kind => Single);
479
 
480
               Term       : constant Project_Node_Id :=
481
                              Default_Project_Node
482
                                (Of_Kind       => N_Term,
483
                                 In_Tree       => Tree,
484
                                 And_Expr_Kind => Single);
485
 
486
               Value      : constant Project_Node_Id :=
487
                              Default_Project_Node
488
                                (Of_Kind       => N_Literal_String,
489
                                 In_Tree       => Tree,
490
                                 And_Expr_Kind => Single);
491
 
492
            begin
493
               if No (Current_Source_Dir) then
494
                  Set_First_Expression_In_List
495
                    (Source_Dirs_List, Tree, To => Expression);
496
               else
497
                  Set_Next_Expression_In_List
498
                    (Current_Source_Dir, Tree, To => Expression);
499
               end if;
500
 
501
               Current_Source_Dir := Expression;
502
               Set_First_Term (Expression, Tree, To => Term);
503
               Set_Current_Term (Term, Tree, To => Value);
504
               Name_Len := 0;
505
               Add_Str_To_Name_Buffer
506
                 (Source_Directories.Table (Source_Dir_Index).all);
507
               Set_String_Value_Of (Value, Tree, To => Name_Find);
508
            end;
509
         end loop;
510
 
511
         --  Add an attribute declaration for Source_Files or Source_List_File
512
         --  with the source list file name that will be created.
513
 
514
         declare
515
            Decl_Item  : constant Project_Node_Id :=
516
                           Default_Project_Node
517
                             (Of_Kind => N_Declarative_Item,
518
                              In_Tree => Tree);
519
 
520
            Attribute  : constant Project_Node_Id :=
521
                            Default_Project_Node
522
                              (Of_Kind       => N_Attribute_Declaration,
523
                               In_Tree       => Tree,
524
                               And_Expr_Kind => Single);
525
 
526
            Expression : constant Project_Node_Id :=
527
                           Default_Project_Node
528
                             (Of_Kind       => N_Expression,
529
                              In_Tree       => Tree,
530
                              And_Expr_Kind => Single);
531
 
532
            Term       : constant Project_Node_Id :=
533
                           Default_Project_Node
534
                             (Of_Kind       => N_Term,
535
                              In_Tree       => Tree,
536
                              And_Expr_Kind => Single);
537
 
538
            Value      : constant Project_Node_Id :=
539
                           Default_Project_Node
540
                             (Of_Kind       => N_Literal_String,
541
                              In_Tree       => Tree,
542
                              And_Expr_Kind => Single);
543
 
544
         begin
545
            Set_Next_Declarative_Item
546
              (Decl_Item, Tree,
547
               To => First_Declarative_Item_Of (Project_Declaration, Tree));
548
            Set_First_Declarative_Item_Of
549
              (Project_Declaration, Tree, To => Decl_Item);
550
            Set_Current_Item_Node (Decl_Item, Tree, To => Attribute);
551
 
552
            Set_Name_Of (Attribute, Tree, To => Name_Source_List_File);
553
            Set_Expression_Of (Attribute, Tree, To => Expression);
554
            Set_First_Term (Expression, Tree, To => Term);
555
            Set_Current_Term (Term, Tree, To => Value);
556
            Name_Len := Source_List_Last;
557
            Name_Buffer (1 .. Name_Len) :=
558
              Source_List_Path (1 .. Source_List_Last);
559
            Set_String_Value_Of (Value, Tree, To => Name_Find);
560
 
561
            --  If there was no comments for attribute Source_List_File, put
562
            --  those for Source_Files, if they exist.
563
 
564
            if Present (Source_List_File_Comments) then
565
               Tree.Project_Nodes.Table (Attribute).Comments :=
566
                 Source_List_File_Comments;
567
            else
568
               Tree.Project_Nodes.Table (Attribute).Comments :=
569
                 Source_Files_Comments;
570
            end if;
571
         end;
572
 
573
         --  Put the sources in the source list files and in the naming
574
         --  project.
575
 
576
         for Source_Index in 1 .. Sources.Last loop
577
 
578
            --  Add the corresponding attribute in the
579
            --  Naming package of the naming project.
580
 
581
            declare
582
               Current_Source : constant Source :=
583
                                  Sources.Table (Source_Index);
584
 
585
               Decl_Item : constant Project_Node_Id :=
586
                             Default_Project_Node
587
                               (Of_Kind =>
588
                                                N_Declarative_Item,
589
                                In_Tree => Tree);
590
 
591
               Attribute : constant Project_Node_Id :=
592
                             Default_Project_Node
593
                               (Of_Kind =>
594
                                                N_Attribute_Declaration,
595
                                In_Tree => Tree);
596
 
597
               Expression : constant Project_Node_Id :=
598
                              Default_Project_Node
599
                                (Of_Kind       => N_Expression,
600
                                 And_Expr_Kind => Single,
601
                                 In_Tree       => Tree);
602
 
603
               Term      : constant Project_Node_Id :=
604
                             Default_Project_Node
605
                               (Of_Kind       => N_Term,
606
                                And_Expr_Kind => Single,
607
                                In_Tree       => Tree);
608
 
609
               Value     : constant Project_Node_Id :=
610
                             Default_Project_Node
611
                               (Of_Kind       => N_Literal_String,
612
                                And_Expr_Kind => Single,
613
                                In_Tree       => Tree);
614
 
615
            begin
616
               --  Add source file name to the source list file if it is not
617
               --  already there.
618
 
619
               if not Source_Files.Get (Current_Source.File_Name) then
620
                  Source_Files.Set (Current_Source.File_Name, True);
621
                  Get_Name_String (Current_Source.File_Name);
622
                  Add_Char_To_Name_Buffer (ASCII.LF);
623
 
624
                  if Write (Source_List_FD,
625
                            Name_Buffer (1)'Address,
626
                            Name_Len) /= Name_Len
627
                  then
628
                     Prj.Com.Fail ("disk full");
629
                  end if;
630
               end if;
631
 
632
               --  For an Ada source, add entry in package Naming
633
 
634
               if Current_Source.Unit_Name /= No_Name then
635
                  Set_Next_Declarative_Item
636
                    (Decl_Item,
637
                     To      => First_Declarative_Item_Of
638
                       (Naming_Package, Tree),
639
                     In_Tree => Tree);
640
                  Set_First_Declarative_Item_Of
641
                    (Naming_Package,
642
                     To      => Decl_Item,
643
                     In_Tree => Tree);
644
                  Set_Current_Item_Node
645
                    (Decl_Item,
646
                     To      => Attribute,
647
                     In_Tree => Tree);
648
 
649
                  --  Is it a spec or a body?
650
 
651
                  if Current_Source.Spec then
652
                     Set_Name_Of
653
                       (Attribute, Tree,
654
                        To => Name_Spec);
655
                  else
656
                     Set_Name_Of
657
                       (Attribute, Tree,
658
                        To => Name_Body);
659
                  end if;
660
 
661
                  --  Get the name of the unit
662
 
663
                  Get_Name_String (Current_Source.Unit_Name);
664
                  To_Lower (Name_Buffer (1 .. Name_Len));
665
                  Set_Associative_Array_Index_Of
666
                    (Attribute, Tree, To => Name_Find);
667
 
668
                  Set_Expression_Of
669
                    (Attribute, Tree, To => Expression);
670
                  Set_First_Term
671
                    (Expression, Tree, To => Term);
672
                  Set_Current_Term
673
                    (Term, Tree, To => Value);
674
 
675
                  --  And set the name of the file
676
 
677
                  Set_String_Value_Of
678
                    (Value, Tree, To => Current_Source.File_Name);
679
                  Set_Source_Index_Of
680
                    (Value, Tree, To => Current_Source.Index);
681
               end if;
682
            end;
683
         end loop;
684
 
685
         --  Close the source list file
686
 
687
         Close (Source_List_FD);
688
 
689
         --  Output the project file
690
 
691
         Prj.PP.Pretty_Print
692
           (Project_Node, Tree,
693
            W_Char                 => Write_A_Char'Access,
694
            W_Eol                  => Write_Eol'Access,
695
            W_Str                  => Write_A_String'Access,
696
            Backward_Compatibility => False);
697
         Close (Output_FD);
698
 
699
         --  Delete the naming project file if it already exists
700
 
701
         Delete_File
702
           (Project_Naming_File_Name (1 .. Project_Naming_Last),
703
            Success => Discard);
704
 
705
         --  Create a new one
706
 
707
         if Opt.Verbose_Mode then
708
            Output.Write_Str ("Creating new naming project file """);
709
            Output.Write_Str (Project_Naming_File_Name
710
                              (1 .. Project_Naming_Last));
711
            Output.Write_Line ("""");
712
         end if;
713
 
714
         Output_FD := Create_New_File
715
           (Project_Naming_File_Name (1 .. Project_Naming_Last),
716
            Fmode => Text);
717
 
718
         --  Fails if naming project file cannot be created
719
 
720
         if Output_FD = Invalid_FD then
721
            Prj.Com.Fail
722
              ("cannot create new """
723
               & Project_Naming_File_Name (1 .. Project_Naming_Last)
724
               & """");
725
         end if;
726
 
727
         --  Output the naming project file
728
 
729
         Prj.PP.Pretty_Print
730
           (Project_Naming_Node, Tree,
731
            W_Char                 => Write_A_Char'Access,
732
            W_Eol                  => Write_Eol'Access,
733
            W_Str                  => Write_A_String'Access,
734
            Backward_Compatibility => False);
735
         Close (Output_FD);
736
 
737
      else
738
         --  For each Ada source, write a pragma Source_File_Name to the
739
         --  configuration pragmas file.
740
 
741
         for Index in 1 .. Sources.Last loop
742
            if Sources.Table (Index).Unit_Name /= No_Name then
743
               Write_A_String ("pragma Source_File_Name");
744
               Write_Eol;
745
               Write_A_String ("  (");
746
               Write_A_String
747
                 (Get_Name_String (Sources.Table (Index).Unit_Name));
748
               Write_A_String (",");
749
               Write_Eol;
750
 
751
               if Sources.Table (Index).Spec then
752
                  Write_A_String ("   Spec_File_Name => """);
753
 
754
               else
755
                  Write_A_String ("   Body_File_Name => """);
756
               end if;
757
 
758
               Write_A_String
759
                 (Get_Name_String (Sources.Table (Index).File_Name));
760
 
761
               Write_A_String ("""");
762
 
763
               if Sources.Table (Index).Index /= 0 then
764
                  Write_A_String (", Index =>");
765
                  Write_A_String (Sources.Table (Index).Index'Img);
766
               end if;
767
 
768
               Write_A_String (");");
769
               Write_Eol;
770
            end if;
771
         end loop;
772
 
773
         Close (Output_FD);
774
      end if;
775
   end Finalize;
776
 
777
   ----------------
778
   -- Initialize --
779
   ----------------
780
 
781
   procedure Initialize
782
     (File_Path         : String;
783
      Project_File      : Boolean;
784
      Preproc_Switches  : Argument_List;
785
      Very_Verbose      : Boolean;
786
      Flags             : Processing_Flags)
787
   is
788
   begin
789
      Makr.Very_Verbose := Initialize.Very_Verbose;
790
      Makr.Project_File := Initialize.Project_File;
791
 
792
      --  Do some needed initializations
793
 
794
      Csets.Initialize;
795
      Namet.Initialize;
796
      Snames.Initialize;
797
      Prj.Initialize (No_Project_Tree);
798
      Prj.Tree.Initialize (Tree);
799
 
800
      Sources.Set_Last (0);
801
      Source_Directories.Set_Last (0);
802
 
803
      --  Initialize the compiler switches
804
 
805
      Args := new Argument_List (1 .. Preproc_Switches'Length + 6);
806
      Args (1) := new String'("-c");
807
      Args (2) := new String'("-gnats");
808
      Args (3) := new String'("-gnatu");
809
      Args (4 .. 3 + Preproc_Switches'Length) := Preproc_Switches;
810
      Args (4 + Preproc_Switches'Length) := new String'("-x");
811
      Args (5 + Preproc_Switches'Length) := new String'("ada");
812
 
813
      --  Get the path and file names
814
 
815
      Path_Name := new
816
        String (1 .. File_Path'Length + Project_File_Extension'Length);
817
      Path_Last := File_Path'Length;
818
 
819
      if File_Names_Case_Sensitive then
820
         Path_Name (1 .. Path_Last) := File_Path;
821
      else
822
         Path_Name (1 .. Path_Last) := To_Lower (File_Path);
823
      end if;
824
 
825
      Path_Name (Path_Last + 1 .. Path_Name'Last) :=
826
        Project_File_Extension;
827
 
828
      --  Get the end of directory information, if any
829
 
830
      for Index in reverse 1 .. Path_Last loop
831
         if Path_Name (Index) = Directory_Separator then
832
            Directory_Last := Index;
833
            exit;
834
         end if;
835
      end loop;
836
 
837
      if Project_File then
838
         if Path_Last < Project_File_Extension'Length + 1
839
           or else Path_Name
840
           (Path_Last - Project_File_Extension'Length + 1 .. Path_Last)
841
           /= Project_File_Extension
842
         then
843
            Path_Last := Path_Name'Last;
844
         end if;
845
 
846
         Output_Name := new String'(To_Lower (Path_Name (1 .. Path_Last)));
847
         Output_Name_Last := Output_Name'Last - 4;
848
 
849
         --  If there is already a project file with the specified name, parse
850
         --  it to get the components that are not automatically generated.
851
 
852
         if Is_Regular_File (Output_Name (1 .. Path_Last)) then
853
            if Opt.Verbose_Mode then
854
               Output.Write_Str ("Parsing already existing project file """);
855
               Output.Write_Str (Output_Name.all);
856
               Output.Write_Line ("""");
857
            end if;
858
 
859
            Part.Parse
860
              (In_Tree                => Tree,
861
               Project                => Project_Node,
862
               Project_File_Name      => Output_Name.all,
863
               Always_Errout_Finalize => False,
864
               Store_Comments         => True,
865
               Is_Config_File         => False,
866
               Flags                  => Flags,
867
               Current_Directory      => Get_Current_Dir,
868
               Packages_To_Check      => Packages_To_Check_By_Gnatname);
869
 
870
            --  Fail if parsing was not successful
871
 
872
            if No (Project_Node) then
873
               Prj.Com.Fail ("parsing of existing project file failed");
874
 
875
            else
876
               --  If parsing was successful, remove the components that are
877
               --  automatically generated, if any, so that they will be
878
               --  unconditionally added later.
879
 
880
               --  Remove the with clause for the naming project file
881
 
882
               declare
883
                  With_Clause : Project_Node_Id :=
884
                                  First_With_Clause_Of (Project_Node, Tree);
885
                  Previous    : Project_Node_Id := Empty_Node;
886
 
887
               begin
888
                  while Present (With_Clause) loop
889
                     if Prj.Tree.Name_Of (With_Clause, Tree) =
890
                          Project_Naming_Id
891
                     then
892
                        if No (Previous) then
893
                           Set_First_With_Clause_Of
894
                             (Project_Node, Tree,
895
                              To => Next_With_Clause_Of (With_Clause, Tree));
896
                        else
897
                           Set_Next_With_Clause_Of
898
                             (Previous, Tree,
899
                              To => Next_With_Clause_Of (With_Clause, Tree));
900
                        end if;
901
 
902
                        exit;
903
                     end if;
904
 
905
                     Previous := With_Clause;
906
                     With_Clause := Next_With_Clause_Of (With_Clause, Tree);
907
                  end loop;
908
               end;
909
 
910
               --  Remove attribute declarations of Source_Files,
911
               --  Source_List_File, Source_Dirs, and the declaration of
912
               --  package Naming, if they exist, but preserve the comments
913
               --  attached to these nodes.
914
 
915
               declare
916
                  Declaration  : Project_Node_Id :=
917
                                   First_Declarative_Item_Of
918
                                     (Project_Declaration_Of
919
                                        (Project_Node, Tree),
920
                                      Tree);
921
                  Previous     : Project_Node_Id := Empty_Node;
922
                  Current_Node : Project_Node_Id := Empty_Node;
923
 
924
                  Name         : Name_Id;
925
                  Kind_Of_Node : Project_Node_Kind;
926
                  Comments     : Project_Node_Id;
927
 
928
               begin
929
                  while Present (Declaration) loop
930
                     Current_Node := Current_Item_Node (Declaration, Tree);
931
 
932
                     Kind_Of_Node := Kind_Of (Current_Node, Tree);
933
 
934
                     if Kind_Of_Node = N_Attribute_Declaration or else
935
                       Kind_Of_Node = N_Package_Declaration
936
                     then
937
                        Name := Prj.Tree.Name_Of (Current_Node, Tree);
938
 
939
                        if Name = Name_Source_Files     or else
940
                           Name = Name_Source_List_File or else
941
                           Name = Name_Source_Dirs      or else
942
                           Name = Name_Naming
943
                        then
944
                           Comments :=
945
                             Tree.Project_Nodes.Table (Current_Node).Comments;
946
 
947
                           if Name = Name_Source_Files then
948
                              Source_Files_Comments := Comments;
949
 
950
                           elsif Name = Name_Source_List_File then
951
                              Source_List_File_Comments := Comments;
952
 
953
                           elsif Name = Name_Source_Dirs then
954
                              Source_Dirs_Comments := Comments;
955
 
956
                           elsif Name = Name_Naming then
957
                              Naming_Package_Comments := Comments;
958
                           end if;
959
 
960
                           if No (Previous) then
961
                              Set_First_Declarative_Item_Of
962
                                (Project_Declaration_Of (Project_Node, Tree),
963
                                 Tree,
964
                                 To => Next_Declarative_Item
965
                                         (Declaration, Tree));
966
 
967
                           else
968
                              Set_Next_Declarative_Item
969
                                (Previous, Tree,
970
                                 To => Next_Declarative_Item
971
                                         (Declaration, Tree));
972
                           end if;
973
 
974
                        else
975
                           Previous := Declaration;
976
                        end if;
977
                     end if;
978
 
979
                     Declaration := Next_Declarative_Item (Declaration, Tree);
980
                  end loop;
981
               end;
982
            end if;
983
         end if;
984
 
985
         if Directory_Last /= 0 then
986
            Output_Name (1 .. Output_Name_Last - Directory_Last) :=
987
              Output_Name (Directory_Last + 1 .. Output_Name_Last);
988
            Output_Name_Last := Output_Name_Last - Directory_Last;
989
         end if;
990
 
991
         --  Get the project name id
992
 
993
         Name_Len := Output_Name_Last;
994
         Name_Buffer (1 .. Name_Len) := Output_Name (1 .. Name_Len);
995
         Output_Name_Id := Name_Find;
996
 
997
         --  Create the project naming file name
998
 
999
         Project_Naming_Last := Output_Name_Last;
1000
         Project_Naming_File_Name :=
1001
           new String'(Output_Name (1 .. Output_Name_Last) &
1002
                       Naming_File_Suffix &
1003
                       Project_File_Extension);
1004
         Project_Naming_Last :=
1005
           Project_Naming_Last + Naming_File_Suffix'Length;
1006
 
1007
         --  Get the project naming id
1008
 
1009
         Name_Len := Project_Naming_Last;
1010
         Name_Buffer (1 .. Name_Len) :=
1011
           Project_Naming_File_Name (1 .. Name_Len);
1012
         Project_Naming_Id := Name_Find;
1013
 
1014
         Project_Naming_Last :=
1015
           Project_Naming_Last + Project_File_Extension'Length;
1016
 
1017
         --  Create the source list file name
1018
 
1019
         Source_List_Last := Output_Name_Last;
1020
         Source_List_Path :=
1021
           new String'(Output_Name (1 .. Output_Name_Last) &
1022
                       Source_List_File_Suffix);
1023
         Source_List_Last :=
1024
           Output_Name_Last + Source_List_File_Suffix'Length;
1025
 
1026
         --  Add the project file extension to the project name
1027
 
1028
         Output_Name
1029
           (Output_Name_Last + 1 ..
1030
              Output_Name_Last + Project_File_Extension'Length) :=
1031
           Project_File_Extension;
1032
         Output_Name_Last := Output_Name_Last + Project_File_Extension'Length;
1033
 
1034
      end if;
1035
 
1036
      --  Change the current directory to the directory of the project file,
1037
      --  if any directory information is specified.
1038
 
1039
      if Directory_Last /= 0 then
1040
         begin
1041
            Change_Dir (Path_Name (1 .. Directory_Last));
1042
         exception
1043
            when Directory_Error =>
1044
               Prj.Com.Fail
1045
                 ("unknown directory """
1046
                  & Path_Name (1 .. Directory_Last)
1047
                  & """");
1048
         end;
1049
      end if;
1050
   end Initialize;
1051
 
1052
   -------------
1053
   -- Process --
1054
   -------------
1055
 
1056
   procedure Process
1057
     (Directories       : Argument_List;
1058
      Name_Patterns     : Regexp_List;
1059
      Excluded_Patterns : Regexp_List;
1060
      Foreign_Patterns  : Regexp_List)
1061
  is
1062
      procedure Process_Directory (Dir_Name : String; Recursively : Boolean);
1063
      --  Look for Ada and foreign sources in a directory, according to the
1064
      --  patterns. When Recursively is True, after looking for sources in
1065
      --  Dir_Name, look also in its subdirectories, if any.
1066
 
1067
      -----------------------
1068
      -- Process_Directory --
1069
      -----------------------
1070
 
1071
      procedure Process_Directory (Dir_Name : String; Recursively : Boolean) is
1072
         Matched : Matched_Type := False;
1073
         Str     : String (1 .. 2_000);
1074
         Canon   : String (1 .. 2_000);
1075
         Last    : Natural;
1076
         Dir     : Dir_Type;
1077
         Do_Process : Boolean := True;
1078
 
1079
         Temp_File_Name         : String_Access := null;
1080
         Save_Last_Source_Index : Natural := 0;
1081
         File_Name_Id           : Name_Id := No_Name;
1082
 
1083
         Current_Source : Source;
1084
 
1085
      begin
1086
         --  Avoid processing the same directory more than once
1087
 
1088
         for Index in 1 .. Processed_Directories.Last loop
1089
            if Processed_Directories.Table (Index).all = Dir_Name then
1090
               Do_Process := False;
1091
               exit;
1092
            end if;
1093
         end loop;
1094
 
1095
         if Do_Process then
1096
            if Opt.Verbose_Mode then
1097
               Output.Write_Str ("Processing directory """);
1098
               Output.Write_Str (Dir_Name);
1099
               Output.Write_Line ("""");
1100
            end if;
1101
 
1102
            Processed_Directories. Increment_Last;
1103
            Processed_Directories.Table (Processed_Directories.Last) :=
1104
              new String'(Dir_Name);
1105
 
1106
            --  Get the source file names from the directory. Fails if the
1107
            --  directory does not exist.
1108
 
1109
            begin
1110
               Open (Dir, Dir_Name);
1111
            exception
1112
               when Directory_Error =>
1113
                  Prj.Com.Fail ("cannot open directory """ & Dir_Name & """");
1114
            end;
1115
 
1116
            --  Process each regular file in the directory
1117
 
1118
            File_Loop : loop
1119
               Read (Dir, Str, Last);
1120
               exit File_Loop when Last = 0;
1121
 
1122
               --  Copy the file name and put it in canonical case to match
1123
               --  against the patterns that have themselves already been put
1124
               --  in canonical case.
1125
 
1126
               Canon (1 .. Last) := Str (1 .. Last);
1127
               Canonical_Case_File_Name (Canon (1 .. Last));
1128
 
1129
               if Is_Regular_File
1130
                 (Dir_Name & Directory_Separator & Str (1 .. Last))
1131
               then
1132
                  Matched := True;
1133
 
1134
                  Name_Len := Last;
1135
                  Name_Buffer (1 .. Name_Len) := Str (1 .. Last);
1136
                  File_Name_Id := Name_Find;
1137
 
1138
                  --  First, check if the file name matches at least one of
1139
                  --  the excluded expressions;
1140
 
1141
                  for Index in Excluded_Patterns'Range loop
1142
                     if
1143
                       Match (Canon (1 .. Last), Excluded_Patterns (Index))
1144
                     then
1145
                        Matched := Excluded;
1146
                        exit;
1147
                     end if;
1148
                  end loop;
1149
 
1150
                  --  If it does not match any of the excluded expressions,
1151
                  --  check if the file name matches at least one of the
1152
                  --  regular expressions.
1153
 
1154
                  if Matched = True then
1155
                     Matched := False;
1156
 
1157
                     for Index in Name_Patterns'Range loop
1158
                        if
1159
                          Match
1160
                            (Canon (1 .. Last), Name_Patterns (Index))
1161
                        then
1162
                           Matched := True;
1163
                           exit;
1164
                        end if;
1165
                     end loop;
1166
                  end if;
1167
 
1168
                  if Very_Verbose
1169
                    or else (Matched = True and then Opt.Verbose_Mode)
1170
                  then
1171
                     Output.Write_Str ("   Checking """);
1172
                     Output.Write_Str (Str (1 .. Last));
1173
                     Output.Write_Line (""": ");
1174
                  end if;
1175
 
1176
                  --  If the file name matches one of the regular expressions,
1177
                  --  parse it to get its unit name.
1178
 
1179
                  if Matched = True then
1180
                     declare
1181
                        FD : File_Descriptor;
1182
                        Success : Boolean;
1183
                        Saved_Output : File_Descriptor;
1184
                        Saved_Error  : File_Descriptor;
1185
 
1186
                     begin
1187
                        --  If we don't have the path of the compiler yet,
1188
                        --  get it now. The compiler name may have a prefix,
1189
                        --  so we get the potentially prefixed name.
1190
 
1191
                        if Gcc_Path = null then
1192
                           declare
1193
                              Prefix_Gcc : String_Access :=
1194
                                             Program_Name (Gcc, "gnatname");
1195
                           begin
1196
                              Gcc_Path :=
1197
                                Locate_Exec_On_Path (Prefix_Gcc.all);
1198
                              Free (Prefix_Gcc);
1199
                           end;
1200
 
1201
                           if Gcc_Path = null then
1202
                              Prj.Com.Fail ("could not locate " & Gcc);
1203
                           end if;
1204
                        end if;
1205
 
1206
                        --  If we don't have yet the file name of the
1207
                        --  temporary file, get it now.
1208
 
1209
                        if Temp_File_Name = null then
1210
                           Create_Temp_File (FD, Temp_File_Name);
1211
 
1212
                           if FD = Invalid_FD then
1213
                              Prj.Com.Fail
1214
                                ("could not create temporary file");
1215
                           end if;
1216
 
1217
                           Close (FD);
1218
                           Delete_File (Temp_File_Name.all, Success);
1219
                        end if;
1220
 
1221
                        Args (Args'Last) := new String'
1222
                          (Dir_Name &
1223
                           Directory_Separator &
1224
                           Str (1 .. Last));
1225
 
1226
                        --  Create the temporary file
1227
 
1228
                        FD := Create_Output_Text_File
1229
                          (Name => Temp_File_Name.all);
1230
 
1231
                        if FD = Invalid_FD then
1232
                           Prj.Com.Fail
1233
                             ("could not create temporary file");
1234
                        end if;
1235
 
1236
                        --  Save the standard output and error
1237
 
1238
                        Saved_Output := Dup (Standout);
1239
                        Saved_Error  := Dup (Standerr);
1240
 
1241
                        --  Set standard output and error to the temporary file
1242
 
1243
                        Dup2 (FD, Standout);
1244
                        Dup2 (FD, Standerr);
1245
 
1246
                        --  And spawn the compiler
1247
 
1248
                        Spawn (Gcc_Path.all, Args.all, Success);
1249
 
1250
                        --  Restore the standard output and error
1251
 
1252
                        Dup2 (Saved_Output, Standout);
1253
                        Dup2 (Saved_Error, Standerr);
1254
 
1255
                        --  Close the temporary file
1256
 
1257
                        Close (FD);
1258
 
1259
                        --  And close the saved standard output and error to
1260
                        --  avoid too many file descriptors.
1261
 
1262
                        Close (Saved_Output);
1263
                        Close (Saved_Error);
1264
 
1265
                        --  Now that standard output is restored, check if
1266
                        --  the compiler ran correctly.
1267
 
1268
                        --  Read the lines of the temporary file:
1269
                        --  they should contain the kind and name of the unit.
1270
 
1271
                        declare
1272
                           File      : Text_File;
1273
                           Text_Line : String (1 .. 1_000);
1274
                           Text_Last : Natural;
1275
 
1276
                        begin
1277
                           Open (File, Temp_File_Name.all);
1278
 
1279
                           if not Is_Valid (File) then
1280
                              Prj.Com.Fail
1281
                                ("could not read temporary file");
1282
                           end if;
1283
 
1284
                           Save_Last_Source_Index := Sources.Last;
1285
 
1286
                           if End_Of_File (File) then
1287
                              if Opt.Verbose_Mode then
1288
                                 if not Success then
1289
                                    Output.Write_Str ("      (process died) ");
1290
                                 end if;
1291
                              end if;
1292
 
1293
                           else
1294
                              Line_Loop : while not End_Of_File (File) loop
1295
                                 Get_Line (File, Text_Line, Text_Last);
1296
 
1297
                                 --  Find the first closing parenthesis
1298
 
1299
                                 Char_Loop : for J in 1 .. Text_Last loop
1300
                                    if Text_Line (J) = ')' then
1301
                                       if J >= 13 and then
1302
                                         Text_Line (1 .. 4) = "Unit"
1303
                                       then
1304
                                          --  Add entry to Sources table
1305
 
1306
                                          Name_Len := J - 12;
1307
                                          Name_Buffer (1 .. Name_Len) :=
1308
                                            Text_Line (6 .. J - 7);
1309
                                          Current_Source :=
1310
                                            (Unit_Name  => Name_Find,
1311
                                             File_Name  => File_Name_Id,
1312
                                             Index => 0,
1313
                                             Spec  => Text_Line (J - 5 .. J) =
1314
                                                        "(spec)");
1315
 
1316
                                          Sources.Append (Current_Source);
1317
                                       end if;
1318
 
1319
                                       exit Char_Loop;
1320
                                    end if;
1321
                                 end loop Char_Loop;
1322
                              end loop Line_Loop;
1323
                           end if;
1324
 
1325
                           if Save_Last_Source_Index = Sources.Last then
1326
                              if Opt.Verbose_Mode then
1327
                                 Output.Write_Line ("      not a unit");
1328
                              end if;
1329
 
1330
                           else
1331
                              if Sources.Last >
1332
                                   Save_Last_Source_Index + 1
1333
                              then
1334
                                 for Index in Save_Last_Source_Index + 1 ..
1335
                                                Sources.Last
1336
                                 loop
1337
                                    Sources.Table (Index).Index :=
1338
                                      Int (Index - Save_Last_Source_Index);
1339
                                 end loop;
1340
                              end if;
1341
 
1342
                              for Index in Save_Last_Source_Index + 1 ..
1343
                                             Sources.Last
1344
                              loop
1345
                                 Current_Source := Sources.Table (Index);
1346
 
1347
                                 if Opt.Verbose_Mode then
1348
                                    if Current_Source.Spec then
1349
                                       Output.Write_Str ("      spec of ");
1350
 
1351
                                    else
1352
                                       Output.Write_Str ("      body of ");
1353
                                    end if;
1354
 
1355
                                    Output.Write_Line
1356
                                      (Get_Name_String
1357
                                         (Current_Source.Unit_Name));
1358
                                 end if;
1359
                              end loop;
1360
                           end if;
1361
 
1362
                           Close (File);
1363
 
1364
                           Delete_File (Temp_File_Name.all, Success);
1365
                        end;
1366
                     end;
1367
 
1368
                  --  File name matches none of the regular expressions
1369
 
1370
                  else
1371
                     --  If file is not excluded, see if this is foreign source
1372
 
1373
                     if Matched /= Excluded then
1374
                        for Index in Foreign_Patterns'Range loop
1375
                           if Match (Canon (1 .. Last),
1376
                                     Foreign_Patterns (Index))
1377
                           then
1378
                              Matched := True;
1379
                              exit;
1380
                           end if;
1381
                        end loop;
1382
                     end if;
1383
 
1384
                     if Very_Verbose then
1385
                        case Matched is
1386
                           when False =>
1387
                              Output.Write_Line ("no match");
1388
 
1389
                           when Excluded =>
1390
                              Output.Write_Line ("excluded");
1391
 
1392
                           when True =>
1393
                              Output.Write_Line ("foreign source");
1394
                        end case;
1395
                     end if;
1396
 
1397
                     if Matched = True then
1398
 
1399
                        --  Add source file name without unit name
1400
 
1401
                        Name_Len := 0;
1402
                        Add_Str_To_Name_Buffer (Canon (1 .. Last));
1403
                        Sources.Append
1404
                          ((File_Name => Name_Find,
1405
                            Unit_Name => No_Name,
1406
                            Index     => 0,
1407
                            Spec      => False));
1408
                     end if;
1409
                  end if;
1410
               end if;
1411
            end loop File_Loop;
1412
 
1413
            Close (Dir);
1414
         end if;
1415
 
1416
         --  If Recursively is True, call itself for each subdirectory.
1417
         --  We do that, even when this directory has already been processed,
1418
         --  because all of its subdirectories may not have been processed.
1419
 
1420
         if Recursively then
1421
            Open (Dir, Dir_Name);
1422
 
1423
            loop
1424
               Read (Dir, Str, Last);
1425
               exit when Last = 0;
1426
 
1427
               --  Do not call itself for "." or ".."
1428
 
1429
               if Is_Directory
1430
                 (Dir_Name & Directory_Separator & Str (1 .. Last))
1431
                 and then Str (1 .. Last) /= "."
1432
                 and then Str (1 .. Last) /= ".."
1433
               then
1434
                  Process_Directory
1435
                    (Dir_Name & Directory_Separator & Str (1 .. Last),
1436
                     Recursively => True);
1437
               end if;
1438
            end loop;
1439
 
1440
            Close (Dir);
1441
         end if;
1442
      end Process_Directory;
1443
 
1444
   --  Start of processing for Process
1445
 
1446
   begin
1447
      Processed_Directories.Set_Last (0);
1448
 
1449
      --  Process each directory
1450
 
1451
      for Index in Directories'Range  loop
1452
 
1453
         declare
1454
            Dir_Name    : constant String := Directories (Index).all;
1455
            Last        : Natural := Dir_Name'Last;
1456
            Recursively : Boolean := False;
1457
            Found       : Boolean;
1458
            Canonical   : String (1 .. Dir_Name'Length) := Dir_Name;
1459
 
1460
         begin
1461
            Canonical_Case_File_Name (Canonical);
1462
 
1463
            Found := False;
1464
            for J in 1 .. Source_Directories.Last loop
1465
               if Source_Directories.Table (J).all = Canonical then
1466
                  Found := True;
1467
                  exit;
1468
               end if;
1469
            end loop;
1470
 
1471
            if not Found then
1472
               Source_Directories.Append (new String'(Canonical));
1473
            end if;
1474
 
1475
            if Dir_Name'Length >= 4
1476
              and then (Dir_Name (Last - 2 .. Last) = "/**")
1477
            then
1478
               Last := Last - 3;
1479
               Recursively := True;
1480
            end if;
1481
 
1482
            Process_Directory (Dir_Name (Dir_Name'First .. Last), Recursively);
1483
         end;
1484
 
1485
      end loop;
1486
   end Process;
1487
 
1488
   ----------------
1489
   -- Write_Char --
1490
   ----------------
1491
   procedure Write_A_Char (C : Character) is
1492
   begin
1493
      Write_A_String ((1 => C));
1494
   end Write_A_Char;
1495
 
1496
   ---------------
1497
   -- Write_Eol --
1498
   ---------------
1499
 
1500
   procedure Write_Eol is
1501
   begin
1502
      Write_A_String ((1 => ASCII.LF));
1503
   end Write_Eol;
1504
 
1505
   --------------------
1506
   -- Write_A_String --
1507
   --------------------
1508
 
1509
   procedure Write_A_String (S : String) is
1510
      Str : String (1 .. S'Length);
1511
 
1512
   begin
1513
      if S'Length > 0 then
1514
         Str := S;
1515
 
1516
         if Write (Output_FD, Str (1)'Address, Str'Length) /= Str'Length then
1517
            Prj.Com.Fail ("disk full");
1518
         end if;
1519
      end if;
1520
   end Write_A_String;
1521
 
1522
end Prj.Makr;

powered by: WebSVN 2.1.0

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