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