File : prj-pp.adb
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- P R J . P P --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 2001-2015, 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 Ada.Characters.Handling; use Ada.Characters.Handling;
27
28 with Output; use Output;
29 with Snames;
30
31 package body Prj.PP is
32
33 use Prj.Tree;
34
35 Not_Tested : array (Project_Node_Kind) of Boolean := (others => True);
36
37 procedure Indicate_Tested (Kind : Project_Node_Kind);
38 -- Set the corresponding component of array Not_Tested to False. Only
39 -- called by Debug pragmas.
40
41 ---------------------
42 -- Indicate_Tested --
43 ---------------------
44
45 procedure Indicate_Tested (Kind : Project_Node_Kind) is
46 begin
47 Not_Tested (Kind) := False;
48 end Indicate_Tested;
49
50 ------------------
51 -- Pretty_Print --
52 ------------------
53
54 procedure Pretty_Print
55 (Project : Prj.Tree.Project_Node_Id;
56 In_Tree : Prj.Tree.Project_Node_Tree_Ref;
57 Increment : Positive := 3;
58 Eliminate_Empty_Case_Constructions : Boolean := False;
59 Minimize_Empty_Lines : Boolean := False;
60 W_Char : Write_Char_Ap := null;
61 W_Eol : Write_Eol_Ap := null;
62 W_Str : Write_Str_Ap := null;
63 Backward_Compatibility : Boolean;
64 Id : Prj.Project_Id := Prj.No_Project;
65 Max_Line_Length : Max_Length_Of_Line :=
66 Max_Length_Of_Line'Last)
67 is
68 procedure Print (Node : Project_Node_Id; Indent : Natural);
69 -- A recursive procedure that traverses a project file tree and outputs
70 -- its source. Current_Prj is the project that we are printing. This
71 -- is used when printing attributes, since in nested packages they
72 -- need to use a fully qualified name.
73
74 procedure Output_Attribute_Name (Name : Name_Id; Indent : Natural);
75 -- Outputs an attribute name, taking into account the value of
76 -- Backward_Compatibility.
77
78 procedure Output_Name
79 (Name : Name_Id;
80 Indent : Natural;
81 Capitalize : Boolean := True);
82 -- Outputs a name
83
84 procedure Start_Line (Indent : Natural);
85 -- Outputs the indentation at the beginning of the line
86
87 procedure Output_Project_File (S : Name_Id);
88 -- Output a project file name in one single string literal
89
90 procedure Output_String (S : Name_Id; Indent : Natural);
91 -- Outputs a string using the default output procedures
92
93 procedure Write_Empty_Line (Always : Boolean := False);
94 -- Outputs an empty line, only if the previous line was not empty
95 -- already and either Always is True or Minimize_Empty_Lines is False.
96
97 procedure Write_Line (S : String);
98 -- Outputs S followed by a new line
99
100 procedure Write_String
101 (S : String;
102 Indent : Natural;
103 Truncated : Boolean := False);
104 -- Outputs S using Write_Str, starting a new line if line would become
105 -- too long, when Truncated = False. When Truncated = True, only the
106 -- part of the string that can fit on the line is output.
107
108 procedure Write_End_Of_Line_Comment (Node : Project_Node_Id);
109 -- Needs comment???
110
111 Write_Char : Write_Char_Ap := Output.Write_Char'Access;
112 Write_Eol : Write_Eol_Ap := Output.Write_Eol'Access;
113 Write_Str : Write_Str_Ap := Output.Write_Str'Access;
114 -- These three access to procedure values are used for the output
115
116 Last_Line_Is_Empty : Boolean := False;
117 -- Used to avoid two consecutive empty lines
118
119 Column : Natural := 0;
120 -- Column number of the last character in the line. Used to avoid
121 -- outputting lines longer than Max_Line_Length.
122
123 First_With_In_List : Boolean := True;
124 -- Indicate that the next with clause is first in a list such as
125 -- with "A", "B";
126 -- First_With_In_List will be True for "A", but not for "B".
127
128 ---------------------------
129 -- Output_Attribute_Name --
130 ---------------------------
131
132 procedure Output_Attribute_Name (Name : Name_Id; Indent : Natural) is
133 begin
134 if Backward_Compatibility then
135 case Name is
136 when Snames.Name_Spec =>
137 Output_Name (Snames.Name_Specification, Indent);
138
139 when Snames.Name_Spec_Suffix =>
140 Output_Name (Snames.Name_Specification_Suffix, Indent);
141
142 when Snames.Name_Body =>
143 Output_Name (Snames.Name_Implementation, Indent);
144
145 when Snames.Name_Body_Suffix =>
146 Output_Name (Snames.Name_Implementation_Suffix, Indent);
147
148 when others =>
149 Output_Name (Name, Indent);
150 end case;
151
152 else
153 Output_Name (Name, Indent);
154 end if;
155 end Output_Attribute_Name;
156
157 -----------------
158 -- Output_Name --
159 -----------------
160
161 procedure Output_Name
162 (Name : Name_Id;
163 Indent : Natural;
164 Capitalize : Boolean := True)
165 is
166 Capital : Boolean := Capitalize;
167
168 begin
169 if Column = 0 and then Indent /= 0 then
170 Start_Line (Indent + Increment);
171 end if;
172
173 Get_Name_String (Name);
174
175 -- If line would become too long, create new line
176
177 if Column + Name_Len > Max_Line_Length then
178 Write_Eol.all;
179 Column := 0;
180
181 if Indent /= 0 then
182 Start_Line (Indent + Increment);
183 end if;
184 end if;
185
186 for J in 1 .. Name_Len loop
187 if Capital then
188 Write_Char (To_Upper (Name_Buffer (J)));
189 else
190 Write_Char (Name_Buffer (J));
191 end if;
192
193 if Capitalize then
194 Capital :=
195 Name_Buffer (J) = '_'
196 or else Is_Digit (Name_Buffer (J));
197 end if;
198 end loop;
199
200 Column := Column + Name_Len;
201 end Output_Name;
202
203 -------------------------
204 -- Output_Project_File --
205 -------------------------
206
207 procedure Output_Project_File (S : Name_Id) is
208 File_Name : constant String := Get_Name_String (S);
209
210 begin
211 Write_Char ('"');
212
213 for J in File_Name'Range loop
214 if File_Name (J) = '"' then
215 Write_Char ('"');
216 Write_Char ('"');
217 else
218 Write_Char (File_Name (J));
219 end if;
220 end loop;
221
222 Write_Char ('"');
223 end Output_Project_File;
224
225 -------------------
226 -- Output_String --
227 -------------------
228
229 procedure Output_String (S : Name_Id; Indent : Natural) is
230 begin
231 if Column = 0 and then Indent /= 0 then
232 Start_Line (Indent + Increment);
233 end if;
234
235 Get_Name_String (S);
236
237 -- If line could become too long, create new line. Note that the
238 -- number of characters on the line could be twice the number of
239 -- character in the string (if every character is a '"') plus two
240 -- (the initial and final '"').
241
242 if Column + Name_Len + Name_Len + 2 > Max_Line_Length then
243 Write_Eol.all;
244 Column := 0;
245
246 if Indent /= 0 then
247 Start_Line (Indent + Increment);
248 end if;
249 end if;
250
251 Write_Char ('"');
252 Column := Column + 1;
253 Get_Name_String (S);
254
255 for J in 1 .. Name_Len loop
256 if Name_Buffer (J) = '"' then
257 Write_Char ('"');
258 Write_Char ('"');
259 Column := Column + 2;
260 else
261 Write_Char (Name_Buffer (J));
262 Column := Column + 1;
263 end if;
264
265 -- If the string does not fit on one line, cut it in parts and
266 -- concatenate.
267
268 if J < Name_Len and then Column >= Max_Line_Length then
269 Write_Str (""" &");
270 Write_Eol.all;
271 Column := 0;
272 Start_Line (Indent + Increment);
273 Write_Char ('"');
274 Column := Column + 1;
275 end if;
276 end loop;
277
278 Write_Char ('"');
279 Column := Column + 1;
280 end Output_String;
281
282 ----------------
283 -- Start_Line --
284 ----------------
285
286 procedure Start_Line (Indent : Natural) is
287 begin
288 if not Minimize_Empty_Lines then
289 Write_Str ((1 .. Indent => ' '));
290 Column := Column + Indent;
291 end if;
292 end Start_Line;
293
294 ----------------------
295 -- Write_Empty_Line --
296 ----------------------
297
298 procedure Write_Empty_Line (Always : Boolean := False) is
299 begin
300 if (Always or else not Minimize_Empty_Lines)
301 and then not Last_Line_Is_Empty
302 then
303 Write_Eol.all;
304 Column := 0;
305 Last_Line_Is_Empty := True;
306 end if;
307 end Write_Empty_Line;
308
309 -------------------------------
310 -- Write_End_Of_Line_Comment --
311 -------------------------------
312
313 procedure Write_End_Of_Line_Comment (Node : Project_Node_Id) is
314 Value : constant Name_Id := End_Of_Line_Comment (Node, In_Tree);
315
316 begin
317 if Value /= No_Name then
318 Write_String (" --", 0);
319 Write_String (Get_Name_String (Value), 0, Truncated => True);
320 end if;
321
322 Write_Line ("");
323 end Write_End_Of_Line_Comment;
324
325 ----------------
326 -- Write_Line --
327 ----------------
328
329 procedure Write_Line (S : String) is
330 begin
331 Write_String (S, 0);
332 Last_Line_Is_Empty := False;
333 Write_Eol.all;
334 Column := 0;
335 end Write_Line;
336
337 ------------------
338 -- Write_String --
339 ------------------
340
341 procedure Write_String
342 (S : String;
343 Indent : Natural;
344 Truncated : Boolean := False)
345 is
346 Length : Natural := S'Length;
347
348 begin
349 if Column = 0 and then Indent /= 0 then
350 Start_Line (Indent + Increment);
351 end if;
352
353 -- If the string would not fit on the line, start a new line
354
355 if Column + Length > Max_Line_Length then
356 if Truncated then
357 Length := Max_Line_Length - Column;
358
359 else
360 Write_Eol.all;
361 Column := 0;
362
363 if Indent /= 0 then
364 Start_Line (Indent + Increment);
365 end if;
366 end if;
367 end if;
368
369 Write_Str (S (S'First .. S'First + Length - 1));
370 Column := Column + Length;
371 end Write_String;
372
373 -----------
374 -- Print --
375 -----------
376
377 procedure Print (Node : Project_Node_Id; Indent : Natural) is
378 begin
379 if Present (Node) then
380 case Kind_Of (Node, In_Tree) is
381 when N_Project =>
382 pragma Debug (Indicate_Tested (N_Project));
383 if Present (First_With_Clause_Of (Node, In_Tree)) then
384
385 -- with clause(s)
386
387 First_With_In_List := True;
388 Print (First_With_Clause_Of (Node, In_Tree), Indent);
389 Write_Empty_Line (Always => True);
390 end if;
391
392 Print (First_Comment_Before (Node, In_Tree), Indent);
393 Start_Line (Indent);
394
395 case Project_Qualifier_Of (Node, In_Tree) is
396 when Unspecified | Standard =>
397 null;
398 when Aggregate =>
399 Write_String ("aggregate ", Indent);
400 when Aggregate_Library =>
401 Write_String ("aggregate library ", Indent);
402 when Library =>
403 Write_String ("library ", Indent);
404 when Configuration =>
405 Write_String ("configuration ", Indent);
406 when Abstract_Project =>
407 Write_String ("abstract ", Indent);
408 end case;
409
410 Write_String ("project ", Indent);
411
412 if Id /= Prj.No_Project then
413 Output_Name (Id.Display_Name, Indent);
414 else
415 Output_Name (Name_Of (Node, In_Tree), Indent);
416 end if;
417
418 -- Check if this project extends another project
419
420 if Extended_Project_Path_Of (Node, In_Tree) /= No_Path then
421 Write_String (" extends ", Indent);
422
423 if Is_Extending_All (Node, In_Tree) then
424 Write_String ("all ", Indent);
425 end if;
426
427 Output_Project_File
428 (Name_Id (Extended_Project_Path_Of (Node, In_Tree)));
429 end if;
430
431 Write_String (" is", Indent);
432 Write_End_Of_Line_Comment (Node);
433 Print
434 (First_Comment_After (Node, In_Tree), Indent + Increment);
435 Write_Empty_Line (Always => True);
436
437 -- Output all of the declarations in the project
438
439 Print (Project_Declaration_Of (Node, In_Tree), Indent);
440 Print
441 (First_Comment_Before_End (Node, In_Tree),
442 Indent + Increment);
443 Start_Line (Indent);
444 Write_String ("end ", Indent);
445
446 if Id /= Prj.No_Project then
447 Output_Name (Id.Display_Name, Indent);
448 else
449 Output_Name (Name_Of (Node, In_Tree), Indent);
450 end if;
451
452 Write_Line (";");
453 Print (First_Comment_After_End (Node, In_Tree), Indent);
454
455 when N_With_Clause =>
456 pragma Debug (Indicate_Tested (N_With_Clause));
457
458 -- The with clause will sometimes contain an invalid name
459 -- when we are importing a virtual project from an extending
460 -- all project. Do not output anything in this case.
461
462 if Name_Of (Node, In_Tree) /= No_Name
463 and then String_Value_Of (Node, In_Tree) /= No_Name
464 then
465 if First_With_In_List then
466 Print (First_Comment_Before (Node, In_Tree), Indent);
467 Start_Line (Indent);
468
469 if Non_Limited_Project_Node_Of (Node, In_Tree) =
470 Empty_Node
471 then
472 Write_String ("limited ", Indent);
473 end if;
474
475 Write_String ("with ", Indent);
476 end if;
477
478 -- Output the project name without concatenation, even if
479 -- the line is too long.
480
481 Output_Project_File (String_Value_Of (Node, In_Tree));
482
483 if Is_Not_Last_In_List (Node, In_Tree) then
484 Write_String (", ", Indent);
485 First_With_In_List := False;
486
487 else
488 Write_String (";", Indent);
489 Write_End_Of_Line_Comment (Node);
490 Print (First_Comment_After (Node, In_Tree), Indent);
491 First_With_In_List := True;
492 end if;
493 end if;
494
495 Print (Next_With_Clause_Of (Node, In_Tree), Indent);
496
497 when N_Project_Declaration =>
498 pragma Debug (Indicate_Tested (N_Project_Declaration));
499
500 if
501 Present (First_Declarative_Item_Of (Node, In_Tree))
502 then
503 Print
504 (First_Declarative_Item_Of (Node, In_Tree),
505 Indent + Increment);
506 Write_Empty_Line (Always => True);
507 end if;
508
509 when N_Declarative_Item =>
510 pragma Debug (Indicate_Tested (N_Declarative_Item));
511 Print (Current_Item_Node (Node, In_Tree), Indent);
512 Print (Next_Declarative_Item (Node, In_Tree), Indent);
513
514 when N_Package_Declaration =>
515 pragma Debug (Indicate_Tested (N_Package_Declaration));
516 Write_Empty_Line (Always => True);
517 Print (First_Comment_Before (Node, In_Tree), Indent);
518 Start_Line (Indent);
519 Write_String ("package ", Indent);
520 Output_Name (Name_Of (Node, In_Tree), Indent);
521
522 if Project_Of_Renamed_Package_Of (Node, In_Tree) /=
523 Empty_Node
524 then
525 if First_Declarative_Item_Of (Node, In_Tree) = Empty_Node
526 then
527 Write_String (" renames ", Indent);
528 else
529 Write_String (" extends ", Indent);
530 end if;
531
532 Output_Name
533 (Name_Of
534 (Project_Of_Renamed_Package_Of (Node, In_Tree),
535 In_Tree),
536 Indent);
537 Write_String (".", Indent);
538 Output_Name (Name_Of (Node, In_Tree), Indent);
539 end if;
540
541 if Project_Of_Renamed_Package_Of (Node, In_Tree) /=
542 Empty_Node
543 and then
544 First_Declarative_Item_Of (Node, In_Tree) = Empty_Node
545 then
546 Write_String (";", Indent);
547 Write_End_Of_Line_Comment (Node);
548 Print (First_Comment_After_End (Node, In_Tree), Indent);
549
550 else
551 Write_String (" is", Indent);
552 Write_End_Of_Line_Comment (Node);
553 Print (First_Comment_After (Node, In_Tree),
554 Indent + Increment);
555
556 if First_Declarative_Item_Of (Node, In_Tree) /= Empty_Node
557 then
558 Print
559 (First_Declarative_Item_Of (Node, In_Tree),
560 Indent + Increment);
561 end if;
562
563 Print (First_Comment_Before_End (Node, In_Tree),
564 Indent + Increment);
565 Start_Line (Indent);
566 Write_String ("end ", Indent);
567 Output_Name (Name_Of (Node, In_Tree), Indent);
568 Write_Line (";");
569 Print (First_Comment_After_End (Node, In_Tree), Indent);
570 Write_Empty_Line;
571 end if;
572
573 when N_String_Type_Declaration =>
574 pragma Debug (Indicate_Tested (N_String_Type_Declaration));
575 Print (First_Comment_Before (Node, In_Tree), Indent);
576 Start_Line (Indent);
577 Write_String ("type ", Indent);
578 Output_Name (Name_Of (Node, In_Tree), Indent);
579 Write_Line (" is");
580 Start_Line (Indent + Increment);
581 Write_String ("(", Indent);
582
583 declare
584 String_Node : Project_Node_Id :=
585 First_Literal_String (Node, In_Tree);
586
587 begin
588 while Present (String_Node) loop
589 Output_String
590 (String_Value_Of (String_Node, In_Tree), Indent);
591 String_Node :=
592 Next_Literal_String (String_Node, In_Tree);
593
594 if Present (String_Node) then
595 Write_String (", ", Indent);
596 end if;
597 end loop;
598 end;
599
600 Write_String (");", Indent);
601 Write_End_Of_Line_Comment (Node);
602 Print (First_Comment_After (Node, In_Tree), Indent);
603
604 when N_Literal_String =>
605 pragma Debug (Indicate_Tested (N_Literal_String));
606 Output_String (String_Value_Of (Node, In_Tree), Indent);
607
608 if Source_Index_Of (Node, In_Tree) /= 0 then
609 Write_String (" at", Indent);
610 Write_String
611 (Source_Index_Of (Node, In_Tree)'Img, Indent);
612 end if;
613
614 when N_Attribute_Declaration =>
615 pragma Debug (Indicate_Tested (N_Attribute_Declaration));
616 Print (First_Comment_Before (Node, In_Tree), Indent);
617 Start_Line (Indent);
618 Write_String ("for ", Indent);
619 Output_Attribute_Name (Name_Of (Node, In_Tree), Indent);
620
621 if Associative_Array_Index_Of (Node, In_Tree) /= No_Name then
622 Write_String (" (", Indent);
623 Output_String
624 (Associative_Array_Index_Of (Node, In_Tree), Indent);
625
626 if Source_Index_Of (Node, In_Tree) /= 0 then
627 Write_String (" at", Indent);
628 Write_String
629 (Source_Index_Of (Node, In_Tree)'Img, Indent);
630 end if;
631
632 Write_String (")", Indent);
633 end if;
634
635 Write_String (" use ", Indent);
636
637 if Present (Expression_Of (Node, In_Tree)) then
638 Print (Expression_Of (Node, In_Tree), Indent);
639
640 else
641 -- Full associative array declaration
642
643 if Present (Associative_Project_Of (Node, In_Tree)) then
644 Output_Name
645 (Name_Of
646 (Associative_Project_Of (Node, In_Tree),
647 In_Tree),
648 Indent);
649
650 if Present (Associative_Package_Of (Node, In_Tree))
651 then
652 Write_String (".", Indent);
653 Output_Name
654 (Name_Of
655 (Associative_Package_Of (Node, In_Tree),
656 In_Tree),
657 Indent);
658 end if;
659
660 elsif Present (Associative_Package_Of (Node, In_Tree))
661 then
662 Output_Name
663 (Name_Of
664 (Associative_Package_Of (Node, In_Tree),
665 In_Tree),
666 Indent);
667 end if;
668
669 Write_String ("'", Indent);
670 Output_Attribute_Name (Name_Of (Node, In_Tree), Indent);
671 end if;
672
673 Write_String (";", Indent);
674 Write_End_Of_Line_Comment (Node);
675 Print (First_Comment_After (Node, In_Tree), Indent);
676
677 when N_Typed_Variable_Declaration =>
678 pragma Debug
679 (Indicate_Tested (N_Typed_Variable_Declaration));
680 Print (First_Comment_Before (Node, In_Tree), Indent);
681 Start_Line (Indent);
682 Output_Name (Name_Of (Node, In_Tree), Indent);
683 Write_String (" : ", Indent);
684 Output_Name
685 (Name_Of (String_Type_Of (Node, In_Tree), In_Tree),
686 Indent);
687 Write_String (" := ", Indent);
688 Print (Expression_Of (Node, In_Tree), Indent);
689 Write_String (";", Indent);
690 Write_End_Of_Line_Comment (Node);
691 Print (First_Comment_After (Node, In_Tree), Indent);
692
693 when N_Variable_Declaration =>
694 pragma Debug (Indicate_Tested (N_Variable_Declaration));
695 Print (First_Comment_Before (Node, In_Tree), Indent);
696 Start_Line (Indent);
697 Output_Name (Name_Of (Node, In_Tree), Indent);
698 Write_String (" := ", Indent);
699 Print (Expression_Of (Node, In_Tree), Indent);
700 Write_String (";", Indent);
701 Write_End_Of_Line_Comment (Node);
702 Print (First_Comment_After (Node, In_Tree), Indent);
703
704 when N_Expression =>
705 pragma Debug (Indicate_Tested (N_Expression));
706 declare
707 Term : Project_Node_Id := First_Term (Node, In_Tree);
708
709 begin
710 while Present (Term) loop
711 Print (Term, Indent);
712 Term := Next_Term (Term, In_Tree);
713
714 if Present (Term) then
715 Write_String (" & ", Indent);
716 end if;
717 end loop;
718 end;
719
720 when N_Term =>
721 pragma Debug (Indicate_Tested (N_Term));
722 Print (Current_Term (Node, In_Tree), Indent);
723
724 when N_Literal_String_List =>
725 pragma Debug (Indicate_Tested (N_Literal_String_List));
726 Write_String ("(", Indent);
727
728 declare
729 Expression : Project_Node_Id :=
730 First_Expression_In_List (Node, In_Tree);
731
732 begin
733 while Present (Expression) loop
734 Print (Expression, Indent);
735 Expression :=
736 Next_Expression_In_List (Expression, In_Tree);
737
738 if Present (Expression) then
739 Write_String (", ", Indent);
740 end if;
741 end loop;
742 end;
743
744 Write_String (")", Indent);
745
746 when N_Variable_Reference =>
747 pragma Debug (Indicate_Tested (N_Variable_Reference));
748 if Present (Project_Node_Of (Node, In_Tree)) then
749 Output_Name
750 (Name_Of (Project_Node_Of (Node, In_Tree), In_Tree),
751 Indent);
752 Write_String (".", Indent);
753 end if;
754
755 if Present (Package_Node_Of (Node, In_Tree)) then
756 Output_Name
757 (Name_Of (Package_Node_Of (Node, In_Tree), In_Tree),
758 Indent);
759 Write_String (".", Indent);
760 end if;
761
762 Output_Name (Name_Of (Node, In_Tree), Indent);
763
764 when N_External_Value =>
765 pragma Debug (Indicate_Tested (N_External_Value));
766 Write_String ("external (", Indent);
767 Print (External_Reference_Of (Node, In_Tree), Indent);
768
769 if Present (External_Default_Of (Node, In_Tree)) then
770 Write_String (", ", Indent);
771 Print (External_Default_Of (Node, In_Tree), Indent);
772 end if;
773
774 Write_String (")", Indent);
775
776 when N_Attribute_Reference =>
777 pragma Debug (Indicate_Tested (N_Attribute_Reference));
778
779 if Present (Project_Node_Of (Node, In_Tree))
780 and then Project_Node_Of (Node, In_Tree) /= Project
781 then
782 Output_Name
783 (Name_Of (Project_Node_Of (Node, In_Tree), In_Tree),
784 Indent);
785
786 if Present (Package_Node_Of (Node, In_Tree)) then
787 Write_String (".", Indent);
788 Output_Name
789 (Name_Of (Package_Node_Of (Node, In_Tree), In_Tree),
790 Indent);
791 end if;
792
793 elsif Present (Package_Node_Of (Node, In_Tree)) then
794 Output_Name
795 (Name_Of (Package_Node_Of (Node, In_Tree), In_Tree),
796 Indent);
797
798 else
799 Write_String ("project", Indent);
800 end if;
801
802 Write_String ("'", Indent);
803 Output_Attribute_Name (Name_Of (Node, In_Tree), Indent);
804
805 declare
806 Index : constant Name_Id :=
807 Associative_Array_Index_Of (Node, In_Tree);
808 begin
809 if Index /= No_Name then
810 Write_String (" (", Indent);
811 Output_String (Index, Indent);
812 Write_String (")", Indent);
813 end if;
814 end;
815
816 when N_Case_Construction =>
817 pragma Debug (Indicate_Tested (N_Case_Construction));
818
819 declare
820 Case_Item : Project_Node_Id;
821 Is_Non_Empty : Boolean := False;
822
823 begin
824 Case_Item := First_Case_Item_Of (Node, In_Tree);
825 while Present (Case_Item) loop
826 if Present
827 (First_Declarative_Item_Of (Case_Item, In_Tree))
828 or else not Eliminate_Empty_Case_Constructions
829 then
830 Is_Non_Empty := True;
831 exit;
832 end if;
833
834 Case_Item := Next_Case_Item (Case_Item, In_Tree);
835 end loop;
836
837 if Is_Non_Empty then
838 Write_Empty_Line;
839 Print (First_Comment_Before (Node, In_Tree), Indent);
840 Start_Line (Indent);
841 Write_String ("case ", Indent);
842 Print
843 (Case_Variable_Reference_Of (Node, In_Tree), Indent);
844 Write_String (" is", Indent);
845 Write_End_Of_Line_Comment (Node);
846 Print
847 (First_Comment_After (Node, In_Tree),
848 Indent + Increment);
849
850 declare
851 Case_Item : Project_Node_Id :=
852 First_Case_Item_Of (Node, In_Tree);
853 begin
854 while Present (Case_Item) loop
855 pragma Assert
856 (Kind_Of (Case_Item, In_Tree) = N_Case_Item);
857 Print (Case_Item, Indent + Increment);
858 Case_Item :=
859 Next_Case_Item (Case_Item, In_Tree);
860 end loop;
861 end;
862
863 Print (First_Comment_Before_End (Node, In_Tree),
864 Indent + Increment);
865 Start_Line (Indent);
866 Write_Line ("end case;");
867 Print
868 (First_Comment_After_End (Node, In_Tree), Indent);
869 end if;
870 end;
871
872 when N_Case_Item =>
873 pragma Debug (Indicate_Tested (N_Case_Item));
874
875 if Present (First_Declarative_Item_Of (Node, In_Tree))
876 or else not Eliminate_Empty_Case_Constructions
877 then
878 Write_Empty_Line;
879 Print (First_Comment_Before (Node, In_Tree), Indent);
880 Start_Line (Indent);
881 Write_String ("when ", Indent);
882
883 if No (First_Choice_Of (Node, In_Tree)) then
884 Write_String ("others", Indent);
885
886 else
887 declare
888 Label : Project_Node_Id :=
889 First_Choice_Of (Node, In_Tree);
890
891 begin
892 while Present (Label) loop
893 Print (Label, Indent);
894 Label := Next_Literal_String (Label, In_Tree);
895
896 if Present (Label) then
897 Write_String (" | ", Indent);
898 end if;
899 end loop;
900 end;
901 end if;
902
903 Write_String (" =>", Indent);
904 Write_End_Of_Line_Comment (Node);
905 Print
906 (First_Comment_After (Node, In_Tree),
907 Indent + Increment);
908
909 declare
910 First : constant Project_Node_Id :=
911 First_Declarative_Item_Of (Node, In_Tree);
912 begin
913 if No (First) then
914 Write_Empty_Line;
915 else
916 Print (First, Indent + Increment);
917 end if;
918 end;
919 end if;
920
921 when N_Comment_Zones =>
922
923 -- Nothing to do, because it will not be processed directly
924
925 null;
926
927 when N_Comment =>
928 pragma Debug (Indicate_Tested (N_Comment));
929
930 if Follows_Empty_Line (Node, In_Tree) then
931 Write_Empty_Line;
932 end if;
933
934 Start_Line (Indent);
935 Write_String ("--", Indent);
936 Write_String
937 (Get_Name_String (String_Value_Of (Node, In_Tree)),
938 Indent,
939 Truncated => True);
940 Write_Line ("");
941
942 if Is_Followed_By_Empty_Line (Node, In_Tree) then
943 Write_Empty_Line;
944 end if;
945
946 Print (Next_Comment (Node, In_Tree), Indent);
947 end case;
948 end if;
949 end Print;
950
951 -- Start of processing for Pretty_Print
952
953 begin
954 if W_Char = null then
955 Write_Char := Output.Write_Char'Access;
956 else
957 Write_Char := W_Char;
958 end if;
959
960 if W_Eol = null then
961 Write_Eol := Output.Write_Eol'Access;
962 else
963 Write_Eol := W_Eol;
964 end if;
965
966 if W_Str = null then
967 Write_Str := Output.Write_Str'Access;
968 else
969 Write_Str := W_Str;
970 end if;
971
972 Print (Project, 0);
973 end Pretty_Print;
974
975 -----------------------
976 -- Output_Statistics --
977 -----------------------
978
979 procedure Output_Statistics is
980 begin
981 Output.Write_Line ("Project_Node_Kinds not tested:");
982
983 for Kind in Project_Node_Kind loop
984 if Kind /= N_Comment_Zones and then Not_Tested (Kind) then
985 Output.Write_Str (" ");
986 Output.Write_Line (Project_Node_Kind'Image (Kind));
987 end if;
988 end loop;
989
990 Output.Write_Eol;
991 end Output_Statistics;
992
993 ---------
994 -- wpr --
995 ---------
996
997 procedure wpr
998 (Project : Prj.Tree.Project_Node_Id;
999 In_Tree : Prj.Tree.Project_Node_Tree_Ref)
1000 is
1001 begin
1002 Pretty_Print (Project, In_Tree, Backward_Compatibility => False);
1003 end wpr;
1004
1005 end Prj.PP;