File : prj-makr.adb
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-2014, 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 Makeutl; use Makeutl;
28 with Opt;
29 with Output;
30 with Osint; use Osint;
31 with Prj; use Prj;
32 with Prj.Com;
33 with Prj.Env;
34 with Prj.Part;
35 with Prj.PP;
36 with Prj.Tree; use Prj.Tree;
37 with Prj.Util; use Prj.Util;
38 with Sdefault;
39 with Snames; use Snames;
40 with Stringt;
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 Stringt.Initialize;
808
809 Prj.Initialize (No_Project_Tree);
810
811 Prj.Tree.Initialize (Root_Environment, Flags);
812 Prj.Env.Initialize_Default_Project_Path
813 (Root_Environment.Project_Path,
814 Target_Name => Sdefault.Target_Name.all);
815
816 Prj.Tree.Initialize (Tree);
817
818 Sources.Set_Last (0);
819 Source_Directories.Set_Last (0);
820
821 -- Initialize the compiler switches
822
823 Args := new Argument_List (1 .. Preproc_Switches'Length + 6);
824 Args (1) := new String'("-c");
825 Args (2) := new String'("-gnats");
826 Args (3) := new String'("-gnatu");
827 Args (4 .. 3 + Preproc_Switches'Length) := Preproc_Switches;
828 Args (4 + Preproc_Switches'Length) := new String'("-x");
829 Args (5 + Preproc_Switches'Length) := new String'("ada");
830
831 -- Get the path and file names
832
833 Path_Name := new
834 String (1 .. File_Path'Length + Project_File_Extension'Length);
835 Path_Last := File_Path'Length;
836
837 if File_Names_Case_Sensitive then
838 Path_Name (1 .. Path_Last) := File_Path;
839 else
840 Path_Name (1 .. Path_Last) := To_Lower (File_Path);
841 end if;
842
843 Path_Name (Path_Last + 1 .. Path_Name'Last) :=
844 Project_File_Extension;
845
846 -- Get the end of directory information, if any
847
848 for Index in reverse 1 .. Path_Last loop
849 if Path_Name (Index) = Directory_Separator then
850 Directory_Last := Index;
851 exit;
852 end if;
853 end loop;
854
855 if Project_File then
856 if Path_Last < Project_File_Extension'Length + 1
857 or else Path_Name
858 (Path_Last - Project_File_Extension'Length + 1 .. Path_Last)
859 /= Project_File_Extension
860 then
861 Path_Last := Path_Name'Last;
862 end if;
863
864 Output_Name := new String'(To_Lower (Path_Name (1 .. Path_Last)));
865 Output_Name_Last := Output_Name'Last - 4;
866
867 -- If there is already a project file with the specified name, parse
868 -- it to get the components that are not automatically generated.
869
870 if Is_Regular_File (Output_Name (1 .. Path_Last)) then
871 if Opt.Verbose_Mode then
872 Output.Write_Str ("Parsing already existing project file """);
873 Output.Write_Str (Output_Name.all);
874 Output.Write_Line ("""");
875 end if;
876
877 Part.Parse
878 (In_Tree => Tree,
879 Project => Project_Node,
880 Project_File_Name => Output_Name.all,
881 Errout_Handling => Part.Finalize_If_Error,
882 Store_Comments => True,
883 Is_Config_File => False,
884 Env => Root_Environment,
885 Current_Directory => Get_Current_Dir,
886 Packages_To_Check => Packages_To_Check_By_Gnatname);
887
888 -- Fail if parsing was not successful
889
890 if No (Project_Node) then
891 Prj.Com.Fail ("parsing of existing project file failed");
892
893 elsif Project_Qualifier_Of (Project_Node, Tree) = Aggregate then
894 Prj.Com.Fail ("aggregate projects are not supported");
895
896 elsif Project_Qualifier_Of (Project_Node, Tree) =
897 Aggregate_Library
898 then
899 Prj.Com.Fail ("aggregate library projects are not supported");
900
901 else
902 -- If parsing was successful, remove the components that are
903 -- automatically generated, if any, so that they will be
904 -- unconditionally added later.
905
906 -- Remove the with clause for the naming project file
907
908 declare
909 With_Clause : Project_Node_Id :=
910 First_With_Clause_Of (Project_Node, Tree);
911 Previous : Project_Node_Id := Empty_Node;
912
913 begin
914 while Present (With_Clause) loop
915 if Prj.Tree.Name_Of (With_Clause, Tree) =
916 Project_Naming_Id
917 then
918 if No (Previous) then
919 Set_First_With_Clause_Of
920 (Project_Node, Tree,
921 To => Next_With_Clause_Of (With_Clause, Tree));
922 else
923 Set_Next_With_Clause_Of
924 (Previous, Tree,
925 To => Next_With_Clause_Of (With_Clause, Tree));
926 end if;
927
928 exit;
929 end if;
930
931 Previous := With_Clause;
932 With_Clause := Next_With_Clause_Of (With_Clause, Tree);
933 end loop;
934 end;
935
936 -- Remove attribute declarations of Source_Files,
937 -- Source_List_File, Source_Dirs, and the declaration of
938 -- package Naming, if they exist, but preserve the comments
939 -- attached to these nodes.
940
941 declare
942 Declaration : Project_Node_Id :=
943 First_Declarative_Item_Of
944 (Project_Declaration_Of
945 (Project_Node, Tree),
946 Tree);
947 Previous : Project_Node_Id := Empty_Node;
948 Current_Node : Project_Node_Id := Empty_Node;
949
950 Name : Name_Id;
951 Kind_Of_Node : Project_Node_Kind;
952 Comments : Project_Node_Id;
953
954 begin
955 while Present (Declaration) loop
956 Current_Node := Current_Item_Node (Declaration, Tree);
957
958 Kind_Of_Node := Kind_Of (Current_Node, Tree);
959
960 if Kind_Of_Node = N_Attribute_Declaration or else
961 Kind_Of_Node = N_Package_Declaration
962 then
963 Name := Prj.Tree.Name_Of (Current_Node, Tree);
964
965 if Nam_In (Name, Name_Source_Files,
966 Name_Source_List_File,
967 Name_Source_Dirs,
968 Name_Naming)
969 then
970 Comments :=
971 Tree.Project_Nodes.Table (Current_Node).Comments;
972
973 if Name = Name_Source_Files then
974 Source_Files_Comments := Comments;
975
976 elsif Name = Name_Source_List_File then
977 Source_List_File_Comments := Comments;
978
979 elsif Name = Name_Source_Dirs then
980 Source_Dirs_Comments := Comments;
981
982 elsif Name = Name_Naming then
983 Naming_Package_Comments := Comments;
984 end if;
985
986 if No (Previous) then
987 Set_First_Declarative_Item_Of
988 (Project_Declaration_Of (Project_Node, Tree),
989 Tree,
990 To => Next_Declarative_Item
991 (Declaration, Tree));
992
993 else
994 Set_Next_Declarative_Item
995 (Previous, Tree,
996 To => Next_Declarative_Item
997 (Declaration, Tree));
998 end if;
999
1000 else
1001 Previous := Declaration;
1002 end if;
1003 end if;
1004
1005 Declaration := Next_Declarative_Item (Declaration, Tree);
1006 end loop;
1007 end;
1008 end if;
1009 end if;
1010
1011 if Directory_Last /= 0 then
1012 Output_Name (1 .. Output_Name_Last - Directory_Last) :=
1013 Output_Name (Directory_Last + 1 .. Output_Name_Last);
1014 Output_Name_Last := Output_Name_Last - Directory_Last;
1015 end if;
1016
1017 -- Get the project name id
1018
1019 Name_Len := Output_Name_Last;
1020 Name_Buffer (1 .. Name_Len) := Output_Name (1 .. Name_Len);
1021 Output_Name_Id := Name_Find;
1022
1023 -- Create the project naming file name
1024
1025 Project_Naming_Last := Output_Name_Last;
1026 Project_Naming_File_Name :=
1027 new String'(Output_Name (1 .. Output_Name_Last) &
1028 Naming_File_Suffix &
1029 Project_File_Extension);
1030 Project_Naming_Last :=
1031 Project_Naming_Last + Naming_File_Suffix'Length;
1032
1033 -- Get the project naming id
1034
1035 Name_Len := Project_Naming_Last;
1036 Name_Buffer (1 .. Name_Len) :=
1037 Project_Naming_File_Name (1 .. Name_Len);
1038 Project_Naming_Id := Name_Find;
1039
1040 Project_Naming_Last :=
1041 Project_Naming_Last + Project_File_Extension'Length;
1042
1043 -- Create the source list file name
1044
1045 Source_List_Last := Output_Name_Last;
1046 Source_List_Path :=
1047 new String'(Output_Name (1 .. Output_Name_Last) &
1048 Source_List_File_Suffix);
1049 Source_List_Last :=
1050 Output_Name_Last + Source_List_File_Suffix'Length;
1051
1052 -- Add the project file extension to the project name
1053
1054 Output_Name
1055 (Output_Name_Last + 1 ..
1056 Output_Name_Last + Project_File_Extension'Length) :=
1057 Project_File_Extension;
1058 Output_Name_Last := Output_Name_Last + Project_File_Extension'Length;
1059
1060 -- Back up project file if it already exists
1061
1062 if not Opt.No_Backup
1063 and then Is_Regular_File (Path_Name (1 .. Path_Last))
1064 then
1065 declare
1066 Discard : Boolean;
1067 Saved_Path : constant String :=
1068 Path_Name (1 .. Path_Last) & ".saved_";
1069 Nmb : Natural;
1070
1071 begin
1072 Nmb := 0;
1073 loop
1074 declare
1075 Img : constant String := Nmb'Img;
1076
1077 begin
1078 if not Is_Regular_File
1079 (Saved_Path & Img (2 .. Img'Last))
1080 then
1081 Copy_File
1082 (Name => Path_Name (1 .. Path_Last),
1083 Pathname => Saved_Path & Img (2 .. Img'Last),
1084 Mode => Overwrite,
1085 Success => Discard);
1086 exit;
1087 end if;
1088
1089 Nmb := Nmb + 1;
1090 end;
1091 end loop;
1092 end;
1093 end if;
1094 end if;
1095
1096 -- Change the current directory to the directory of the project file,
1097 -- if any directory information is specified.
1098
1099 if Directory_Last /= 0 then
1100 begin
1101 Change_Dir (Path_Name (1 .. Directory_Last));
1102 exception
1103 when Directory_Error =>
1104 Prj.Com.Fail
1105 ("unknown directory """
1106 & Path_Name (1 .. Directory_Last)
1107 & """");
1108 end;
1109 end if;
1110 end Initialize;
1111
1112 -------------
1113 -- Process --
1114 -------------
1115
1116 procedure Process
1117 (Directories : Argument_List;
1118 Name_Patterns : Regexp_List;
1119 Excluded_Patterns : Regexp_List;
1120 Foreign_Patterns : Regexp_List)
1121 is
1122 procedure Process_Directory (Dir_Name : String; Recursively : Boolean);
1123 -- Look for Ada and foreign sources in a directory, according to the
1124 -- patterns. When Recursively is True, after looking for sources in
1125 -- Dir_Name, look also in its subdirectories, if any.
1126
1127 -----------------------
1128 -- Process_Directory --
1129 -----------------------
1130
1131 procedure Process_Directory (Dir_Name : String; Recursively : Boolean) is
1132 Matched : Matched_Type := False;
1133 Str : String (1 .. 2_000);
1134 Canon : String (1 .. 2_000);
1135 Last : Natural;
1136 Dir : Dir_Type;
1137 Do_Process : Boolean := True;
1138
1139 Temp_File_Name : String_Access := null;
1140 Save_Last_Source_Index : Natural := 0;
1141 File_Name_Id : Name_Id := No_Name;
1142
1143 Current_Source : Source;
1144
1145 begin
1146 -- Avoid processing the same directory more than once
1147
1148 for Index in 1 .. Processed_Directories.Last loop
1149 if Processed_Directories.Table (Index).all = Dir_Name then
1150 Do_Process := False;
1151 exit;
1152 end if;
1153 end loop;
1154
1155 if Do_Process then
1156 if Opt.Verbose_Mode then
1157 Output.Write_Str ("Processing directory """);
1158 Output.Write_Str (Dir_Name);
1159 Output.Write_Line ("""");
1160 end if;
1161
1162 Processed_Directories. Increment_Last;
1163 Processed_Directories.Table (Processed_Directories.Last) :=
1164 new String'(Dir_Name);
1165
1166 -- Get the source file names from the directory. Fails if the
1167 -- directory does not exist.
1168
1169 begin
1170 Open (Dir, Dir_Name);
1171 exception
1172 when Directory_Error =>
1173 Prj.Com.Fail ("cannot open directory """ & Dir_Name & """");
1174 end;
1175
1176 -- Process each regular file in the directory
1177
1178 File_Loop : loop
1179 Read (Dir, Str, Last);
1180 exit File_Loop when Last = 0;
1181
1182 -- Copy the file name and put it in canonical case to match
1183 -- against the patterns that have themselves already been put
1184 -- in canonical case.
1185
1186 Canon (1 .. Last) := Str (1 .. Last);
1187 Canonical_Case_File_Name (Canon (1 .. Last));
1188
1189 if Is_Regular_File
1190 (Dir_Name & Directory_Separator & Str (1 .. Last))
1191 then
1192 Matched := True;
1193
1194 Name_Len := Last;
1195 Name_Buffer (1 .. Name_Len) := Str (1 .. Last);
1196 File_Name_Id := Name_Find;
1197
1198 -- First, check if the file name matches at least one of
1199 -- the excluded expressions;
1200
1201 for Index in Excluded_Patterns'Range loop
1202 if
1203 Match (Canon (1 .. Last), Excluded_Patterns (Index))
1204 then
1205 Matched := Excluded;
1206 exit;
1207 end if;
1208 end loop;
1209
1210 -- If it does not match any of the excluded expressions,
1211 -- check if the file name matches at least one of the
1212 -- regular expressions.
1213
1214 if Matched = True then
1215 Matched := False;
1216
1217 for Index in Name_Patterns'Range loop
1218 if
1219 Match
1220 (Canon (1 .. Last), Name_Patterns (Index))
1221 then
1222 Matched := True;
1223 exit;
1224 end if;
1225 end loop;
1226 end if;
1227
1228 if Very_Verbose
1229 or else (Matched = True and then Opt.Verbose_Mode)
1230 then
1231 Output.Write_Str (" Checking """);
1232 Output.Write_Str (Str (1 .. Last));
1233 Output.Write_Line (""": ");
1234 end if;
1235
1236 -- If the file name matches one of the regular expressions,
1237 -- parse it to get its unit name.
1238
1239 if Matched = True then
1240 declare
1241 FD : File_Descriptor;
1242 Success : Boolean;
1243 Saved_Output : File_Descriptor;
1244 Saved_Error : File_Descriptor;
1245 Tmp_File : Path_Name_Type;
1246
1247 begin
1248 -- If we don't have the path of the compiler yet,
1249 -- get it now. The compiler name may have a prefix,
1250 -- so we get the potentially prefixed name.
1251
1252 if Gcc_Path = null then
1253 declare
1254 Prefix_Gcc : String_Access :=
1255 Program_Name (Gcc, "gnatname");
1256 begin
1257 Gcc_Path :=
1258 Locate_Exec_On_Path (Prefix_Gcc.all);
1259 Free (Prefix_Gcc);
1260 end;
1261
1262 if Gcc_Path = null then
1263 Prj.Com.Fail ("could not locate " & Gcc);
1264 end if;
1265 end if;
1266
1267 -- Create the temporary file
1268
1269 Tempdir.Create_Temp_File (FD, Tmp_File);
1270
1271 if FD = Invalid_FD then
1272 Prj.Com.Fail
1273 ("could not create temporary file");
1274
1275 else
1276 Temp_File_Name :=
1277 new String'(Get_Name_String (Tmp_File));
1278 end if;
1279
1280 Args (Args'Last) :=
1281 new String'
1282 (Dir_Name & Directory_Separator & Str (1 .. Last));
1283
1284 -- Save the standard output and error
1285
1286 Saved_Output := Dup (Standout);
1287 Saved_Error := Dup (Standerr);
1288
1289 -- Set standard output and error to the temporary file
1290
1291 Dup2 (FD, Standout);
1292 Dup2 (FD, Standerr);
1293
1294 -- And spawn the compiler
1295
1296 Spawn (Gcc_Path.all, Args.all, Success);
1297
1298 -- Restore the standard output and error
1299
1300 Dup2 (Saved_Output, Standout);
1301 Dup2 (Saved_Error, Standerr);
1302
1303 -- Close the temporary file
1304
1305 Close (FD);
1306
1307 -- And close the saved standard output and error to
1308 -- avoid too many file descriptors.
1309
1310 Close (Saved_Output);
1311 Close (Saved_Error);
1312
1313 -- Now that standard output is restored, check if
1314 -- the compiler ran correctly.
1315
1316 -- Read the lines of the temporary file:
1317 -- they should contain the kind and name of the unit.
1318
1319 declare
1320 File : Text_File;
1321 Text_Line : String (1 .. 1_000);
1322 Text_Last : Natural;
1323
1324 begin
1325 Open (File, Temp_File_Name.all);
1326
1327 if not Is_Valid (File) then
1328 Prj.Com.Fail
1329 ("could not read temporary file " &
1330 Temp_File_Name.all);
1331 end if;
1332
1333 Save_Last_Source_Index := Sources.Last;
1334
1335 if End_Of_File (File) then
1336 if Opt.Verbose_Mode then
1337 if not Success then
1338 Output.Write_Str (" (process died) ");
1339 end if;
1340 end if;
1341
1342 else
1343 Line_Loop : while not End_Of_File (File) loop
1344 Get_Line (File, Text_Line, Text_Last);
1345
1346 -- Find the first closing parenthesis
1347
1348 Char_Loop : for J in 1 .. Text_Last loop
1349 if Text_Line (J) = ')' then
1350 if J >= 13 and then
1351 Text_Line (1 .. 4) = "Unit"
1352 then
1353 -- Add entry to Sources table
1354
1355 Name_Len := J - 12;
1356 Name_Buffer (1 .. Name_Len) :=
1357 Text_Line (6 .. J - 7);
1358 Current_Source :=
1359 (Unit_Name => Name_Find,
1360 File_Name => File_Name_Id,
1361 Index => 0,
1362 Spec => Text_Line (J - 5 .. J) =
1363 "(spec)");
1364
1365 Sources.Append (Current_Source);
1366 end if;
1367
1368 exit Char_Loop;
1369 end if;
1370 end loop Char_Loop;
1371 end loop Line_Loop;
1372 end if;
1373
1374 if Save_Last_Source_Index = Sources.Last then
1375 if Opt.Verbose_Mode then
1376 Output.Write_Line (" not a unit");
1377 end if;
1378
1379 else
1380 if Sources.Last >
1381 Save_Last_Source_Index + 1
1382 then
1383 for Index in Save_Last_Source_Index + 1 ..
1384 Sources.Last
1385 loop
1386 Sources.Table (Index).Index :=
1387 Int (Index - Save_Last_Source_Index);
1388 end loop;
1389 end if;
1390
1391 for Index in Save_Last_Source_Index + 1 ..
1392 Sources.Last
1393 loop
1394 Current_Source := Sources.Table (Index);
1395
1396 if Opt.Verbose_Mode then
1397 if Current_Source.Spec then
1398 Output.Write_Str (" spec of ");
1399
1400 else
1401 Output.Write_Str (" body of ");
1402 end if;
1403
1404 Output.Write_Line
1405 (Get_Name_String
1406 (Current_Source.Unit_Name));
1407 end if;
1408 end loop;
1409 end if;
1410
1411 Close (File);
1412
1413 Delete_File (Temp_File_Name.all, Success);
1414 end;
1415 end;
1416
1417 -- File name matches none of the regular expressions
1418
1419 else
1420 -- If file is not excluded, see if this is foreign source
1421
1422 if Matched /= Excluded then
1423 for Index in Foreign_Patterns'Range loop
1424 if Match (Canon (1 .. Last),
1425 Foreign_Patterns (Index))
1426 then
1427 Matched := True;
1428 exit;
1429 end if;
1430 end loop;
1431 end if;
1432
1433 if Very_Verbose then
1434 case Matched is
1435 when False =>
1436 Output.Write_Line ("no match");
1437
1438 when Excluded =>
1439 Output.Write_Line ("excluded");
1440
1441 when True =>
1442 Output.Write_Line ("foreign source");
1443 end case;
1444 end if;
1445
1446 if Matched = True then
1447
1448 -- Add source file name without unit name
1449
1450 Name_Len := 0;
1451 Add_Str_To_Name_Buffer (Canon (1 .. Last));
1452 Sources.Append
1453 ((File_Name => Name_Find,
1454 Unit_Name => No_Name,
1455 Index => 0,
1456 Spec => False));
1457 end if;
1458 end if;
1459 end if;
1460 end loop File_Loop;
1461
1462 Close (Dir);
1463 end if;
1464
1465 -- If Recursively is True, call itself for each subdirectory.
1466 -- We do that, even when this directory has already been processed,
1467 -- because all of its subdirectories may not have been processed.
1468
1469 if Recursively then
1470 Open (Dir, Dir_Name);
1471
1472 loop
1473 Read (Dir, Str, Last);
1474 exit when Last = 0;
1475
1476 -- Do not call itself for "." or ".."
1477
1478 if Is_Directory
1479 (Dir_Name & Directory_Separator & Str (1 .. Last))
1480 and then Str (1 .. Last) /= "."
1481 and then Str (1 .. Last) /= ".."
1482 then
1483 Process_Directory
1484 (Dir_Name & Directory_Separator & Str (1 .. Last),
1485 Recursively => True);
1486 end if;
1487 end loop;
1488
1489 Close (Dir);
1490 end if;
1491 end Process_Directory;
1492
1493 -- Start of processing for Process
1494
1495 begin
1496 Processed_Directories.Set_Last (0);
1497
1498 -- Process each directory
1499
1500 for Index in Directories'Range loop
1501
1502 declare
1503 Dir_Name : constant String := Directories (Index).all;
1504 Last : Natural := Dir_Name'Last;
1505 Recursively : Boolean := False;
1506 Found : Boolean;
1507 Canonical : String (1 .. Dir_Name'Length) := Dir_Name;
1508
1509 begin
1510 Canonical_Case_File_Name (Canonical);
1511
1512 Found := False;
1513 for J in 1 .. Source_Directories.Last loop
1514 if Source_Directories.Table (J).all = Canonical then
1515 Found := True;
1516 exit;
1517 end if;
1518 end loop;
1519
1520 if not Found then
1521 Source_Directories.Append (new String'(Canonical));
1522 end if;
1523
1524 if Dir_Name'Length >= 4
1525 and then (Dir_Name (Last - 2 .. Last) = "/**")
1526 then
1527 Last := Last - 3;
1528 Recursively := True;
1529 end if;
1530
1531 Process_Directory (Dir_Name (Dir_Name'First .. Last), Recursively);
1532 end;
1533
1534 end loop;
1535 end Process;
1536
1537 ----------------
1538 -- Write_Char --
1539 ----------------
1540 procedure Write_A_Char (C : Character) is
1541 begin
1542 Write_A_String ((1 => C));
1543 end Write_A_Char;
1544
1545 ---------------
1546 -- Write_Eol --
1547 ---------------
1548
1549 procedure Write_Eol is
1550 begin
1551 Write_A_String ((1 => ASCII.LF));
1552 end Write_Eol;
1553
1554 --------------------
1555 -- Write_A_String --
1556 --------------------
1557
1558 procedure Write_A_String (S : String) is
1559 Str : String (1 .. S'Length);
1560
1561 begin
1562 if S'Length > 0 then
1563 Str := S;
1564
1565 if Write (Output_FD, Str (1)'Address, Str'Length) /= Str'Length then
1566 Prj.Com.Fail ("disk full");
1567 end if;
1568 end if;
1569 end Write_A_String;
1570
1571 end Prj.Makr;