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