?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
PR rtl-optimization/79386
[official-gcc.git] / gcc / ada / prj-pp.adb
blob6da5ae2325d0389b3ef0f49a4c9052aad0905523
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- P R J . P P --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 2001-2016, 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 Standard
397 | Unspecified
398 =>
399 null;
400 when Aggregate =>
401 Write_String ("aggregate ", Indent);
402
403 when Aggregate_Library =>
404 Write_String ("aggregate library ", Indent);
405 when Library =>
406 Write_String ("library ", Indent);
407
408 when Configuration =>
409 Write_String ("configuration ", Indent);
410
411 when Abstract_Project =>
412 Write_String ("abstract ", Indent);
413 end case;
414
415 Write_String ("project ", Indent);
416
417 if Id /= Prj.No_Project then
418 Output_Name (Id.Display_Name, Indent);
419 else
420 Output_Name (Name_Of (Node, In_Tree), Indent);
421 end if;
422
423 -- Check if this project extends another project
424
425 if Extended_Project_Path_Of (Node, In_Tree) /= No_Path then
426 Write_String (" extends ", Indent);
427
428 if Is_Extending_All (Node, In_Tree) then
429 Write_String ("all ", Indent);
430 end if;
431
432 Output_Project_File
433 (Name_Id (Extended_Project_Path_Of (Node, In_Tree)));
434 end if;
435
436 Write_String (" is", Indent);
437 Write_End_Of_Line_Comment (Node);
438 Print
439 (First_Comment_After (Node, In_Tree), Indent + Increment);
440 Write_Empty_Line (Always => True);
441
442 -- Output all of the declarations in the project
443
444 Print (Project_Declaration_Of (Node, In_Tree), Indent);
445 Print
446 (First_Comment_Before_End (Node, In_Tree),
447 Indent + Increment);
448 Start_Line (Indent);
449 Write_String ("end ", Indent);
450
451 if Id /= Prj.No_Project then
452 Output_Name (Id.Display_Name, Indent);
453 else
454 Output_Name (Name_Of (Node, In_Tree), Indent);
455 end if;
456
457 Write_Line (";");
458 Print (First_Comment_After_End (Node, In_Tree), Indent);
459
460 when N_With_Clause =>
461 pragma Debug (Indicate_Tested (N_With_Clause));
462
463 -- The with clause will sometimes contain an invalid name
464 -- when we are importing a virtual project from an extending
465 -- all project. Do not output anything in this case.
466
467 if Name_Of (Node, In_Tree) /= No_Name
468 and then String_Value_Of (Node, In_Tree) /= No_Name
469 then
470 if First_With_In_List then
471 Print (First_Comment_Before (Node, In_Tree), Indent);
472 Start_Line (Indent);
473
474 if Non_Limited_Project_Node_Of (Node, In_Tree) =
475 Empty_Node
476 then
477 Write_String ("limited ", Indent);
478 end if;
479
480 Write_String ("with ", Indent);
481 end if;
482
483 -- Output the project name without concatenation, even if
484 -- the line is too long.
485
486 Output_Project_File (String_Value_Of (Node, In_Tree));
487
488 if Is_Not_Last_In_List (Node, In_Tree) then
489 Write_String (", ", Indent);
490 First_With_In_List := False;
491
492 else
493 Write_String (";", Indent);
494 Write_End_Of_Line_Comment (Node);
495 Print (First_Comment_After (Node, In_Tree), Indent);
496 First_With_In_List := True;
497 end if;
498 end if;
499
500 Print (Next_With_Clause_Of (Node, In_Tree), Indent);
501
502 when N_Project_Declaration =>
503 pragma Debug (Indicate_Tested (N_Project_Declaration));
504
505 if
506 Present (First_Declarative_Item_Of (Node, In_Tree))
507 then
508 Print
509 (First_Declarative_Item_Of (Node, In_Tree),
510 Indent + Increment);
511 Write_Empty_Line (Always => True);
512 end if;
513
514 when N_Declarative_Item =>
515 pragma Debug (Indicate_Tested (N_Declarative_Item));
516 Print (Current_Item_Node (Node, In_Tree), Indent);
517 Print (Next_Declarative_Item (Node, In_Tree), Indent);
518
519 when N_Package_Declaration =>
520 pragma Debug (Indicate_Tested (N_Package_Declaration));
521 Write_Empty_Line (Always => True);
522 Print (First_Comment_Before (Node, In_Tree), Indent);
523 Start_Line (Indent);
524 Write_String ("package ", Indent);
525 Output_Name (Name_Of (Node, In_Tree), Indent);
526
527 if Project_Of_Renamed_Package_Of (Node, In_Tree) /=
528 Empty_Node
529 then
530 if First_Declarative_Item_Of (Node, In_Tree) = Empty_Node
531 then
532 Write_String (" renames ", Indent);
533 else
534 Write_String (" extends ", Indent);
535 end if;
536
537 Output_Name
538 (Name_Of
539 (Project_Of_Renamed_Package_Of (Node, In_Tree),
540 In_Tree),
541 Indent);
542 Write_String (".", Indent);
543 Output_Name (Name_Of (Node, In_Tree), Indent);
544 end if;
545
546 if Project_Of_Renamed_Package_Of (Node, In_Tree) /=
547 Empty_Node
548 and then
549 First_Declarative_Item_Of (Node, In_Tree) = Empty_Node
550 then
551 Write_String (";", Indent);
552 Write_End_Of_Line_Comment (Node);
553 Print (First_Comment_After_End (Node, In_Tree), Indent);
554
555 else
556 Write_String (" is", Indent);
557 Write_End_Of_Line_Comment (Node);
558 Print (First_Comment_After (Node, In_Tree),
559 Indent + Increment);
560
561 if First_Declarative_Item_Of (Node, In_Tree) /= Empty_Node
562 then
563 Print
564 (First_Declarative_Item_Of (Node, In_Tree),
565 Indent + Increment);
566 end if;
567
568 Print (First_Comment_Before_End (Node, In_Tree),
569 Indent + Increment);
570 Start_Line (Indent);
571 Write_String ("end ", Indent);
572 Output_Name (Name_Of (Node, In_Tree), Indent);
573 Write_Line (";");
574 Print (First_Comment_After_End (Node, In_Tree), Indent);
575 Write_Empty_Line;
576 end if;
577
578 when N_String_Type_Declaration =>
579 pragma Debug (Indicate_Tested (N_String_Type_Declaration));
580 Print (First_Comment_Before (Node, In_Tree), Indent);
581 Start_Line (Indent);
582 Write_String ("type ", Indent);
583 Output_Name (Name_Of (Node, In_Tree), Indent);
584 Write_Line (" is");
585 Start_Line (Indent + Increment);
586 Write_String ("(", Indent);
587
588 declare
589 String_Node : Project_Node_Id :=
590 First_Literal_String (Node, In_Tree);
591
592 begin
593 while Present (String_Node) loop
594 Output_String
595 (String_Value_Of (String_Node, In_Tree), Indent);
596 String_Node :=
597 Next_Literal_String (String_Node, In_Tree);
598
599 if Present (String_Node) then
600 Write_String (", ", Indent);
601 end if;
602 end loop;
603 end;
604
605 Write_String (");", Indent);
606 Write_End_Of_Line_Comment (Node);
607 Print (First_Comment_After (Node, In_Tree), Indent);
608
609 when N_Literal_String =>
610 pragma Debug (Indicate_Tested (N_Literal_String));
611 Output_String (String_Value_Of (Node, In_Tree), Indent);
612
613 if Source_Index_Of (Node, In_Tree) /= 0 then
614 Write_String (" at", Indent);
615 Write_String
616 (Source_Index_Of (Node, In_Tree)'Img, Indent);
617 end if;
618
619 when N_Attribute_Declaration =>
620 pragma Debug (Indicate_Tested (N_Attribute_Declaration));
621 Print (First_Comment_Before (Node, In_Tree), Indent);
622 Start_Line (Indent);
623 Write_String ("for ", Indent);
624 Output_Attribute_Name (Name_Of (Node, In_Tree), Indent);
625
626 if Associative_Array_Index_Of (Node, In_Tree) /= No_Name then
627 Write_String (" (", Indent);
628 Output_String
629 (Associative_Array_Index_Of (Node, In_Tree), Indent);
630
631 if Source_Index_Of (Node, In_Tree) /= 0 then
632 Write_String (" at", Indent);
633 Write_String
634 (Source_Index_Of (Node, In_Tree)'Img, Indent);
635 end if;
636
637 Write_String (")", Indent);
638 end if;
639
640 Write_String (" use ", Indent);
641
642 if Present (Expression_Of (Node, In_Tree)) then
643 Print (Expression_Of (Node, In_Tree), Indent);
644
645 else
646 -- Full associative array declaration
647
648 if Present (Associative_Project_Of (Node, In_Tree)) then
649 Output_Name
650 (Name_Of
651 (Associative_Project_Of (Node, In_Tree),
652 In_Tree),
653 Indent);
654
655 if Present (Associative_Package_Of (Node, In_Tree))
656 then
657 Write_String (".", Indent);
658 Output_Name
659 (Name_Of
660 (Associative_Package_Of (Node, In_Tree),
661 In_Tree),
662 Indent);
663 end if;
664
665 elsif Present (Associative_Package_Of (Node, In_Tree))
666 then
667 Output_Name
668 (Name_Of
669 (Associative_Package_Of (Node, In_Tree),
670 In_Tree),
671 Indent);
672 end if;
673
674 Write_String ("'", Indent);
675 Output_Attribute_Name (Name_Of (Node, In_Tree), Indent);
676 end if;
677
678 Write_String (";", Indent);
679 Write_End_Of_Line_Comment (Node);
680 Print (First_Comment_After (Node, In_Tree), Indent);
681
682 when N_Typed_Variable_Declaration =>
683 pragma Debug
684 (Indicate_Tested (N_Typed_Variable_Declaration));
685 Print (First_Comment_Before (Node, In_Tree), Indent);
686 Start_Line (Indent);
687 Output_Name (Name_Of (Node, In_Tree), Indent);
688 Write_String (" : ", Indent);
689 Output_Name
690 (Name_Of (String_Type_Of (Node, In_Tree), In_Tree),
691 Indent);
692 Write_String (" := ", Indent);
693 Print (Expression_Of (Node, In_Tree), Indent);
694 Write_String (";", Indent);
695 Write_End_Of_Line_Comment (Node);
696 Print (First_Comment_After (Node, In_Tree), Indent);
697
698 when N_Variable_Declaration =>
699 pragma Debug (Indicate_Tested (N_Variable_Declaration));
700 Print (First_Comment_Before (Node, In_Tree), Indent);
701 Start_Line (Indent);
702 Output_Name (Name_Of (Node, In_Tree), Indent);
703 Write_String (" := ", Indent);
704 Print (Expression_Of (Node, In_Tree), Indent);
705 Write_String (";", Indent);
706 Write_End_Of_Line_Comment (Node);
707 Print (First_Comment_After (Node, In_Tree), Indent);
708
709 when N_Expression =>
710 pragma Debug (Indicate_Tested (N_Expression));
711 declare
712 Term : Project_Node_Id := First_Term (Node, In_Tree);
713
714 begin
715 while Present (Term) loop
716 Print (Term, Indent);
717 Term := Next_Term (Term, In_Tree);
718
719 if Present (Term) then
720 Write_String (" & ", Indent);
721 end if;
722 end loop;
723 end;
724
725 when N_Term =>
726 pragma Debug (Indicate_Tested (N_Term));
727 Print (Current_Term (Node, In_Tree), Indent);
728
729 when N_Literal_String_List =>
730 pragma Debug (Indicate_Tested (N_Literal_String_List));
731 Write_String ("(", Indent);
732
733 declare
734 Expression : Project_Node_Id :=
735 First_Expression_In_List (Node, In_Tree);
736
737 begin
738 while Present (Expression) loop
739 Print (Expression, Indent);
740 Expression :=
741 Next_Expression_In_List (Expression, In_Tree);
742
743 if Present (Expression) then
744 Write_String (", ", Indent);
745 end if;
746 end loop;
747 end;
748
749 Write_String (")", Indent);
750
751 when N_Variable_Reference =>
752 pragma Debug (Indicate_Tested (N_Variable_Reference));
753 if Present (Project_Node_Of (Node, In_Tree)) then
754 Output_Name
755 (Name_Of (Project_Node_Of (Node, In_Tree), In_Tree),
756 Indent);
757 Write_String (".", Indent);
758 end if;
759
760 if Present (Package_Node_Of (Node, In_Tree)) then
761 Output_Name
762 (Name_Of (Package_Node_Of (Node, In_Tree), In_Tree),
763 Indent);
764 Write_String (".", Indent);
765 end if;
766
767 Output_Name (Name_Of (Node, In_Tree), Indent);
768
769 when N_External_Value =>
770 pragma Debug (Indicate_Tested (N_External_Value));
771 Write_String ("external (", Indent);
772 Print (External_Reference_Of (Node, In_Tree), Indent);
773
774 if Present (External_Default_Of (Node, In_Tree)) then
775 Write_String (", ", Indent);
776 Print (External_Default_Of (Node, In_Tree), Indent);
777 end if;
778
779 Write_String (")", Indent);
780
781 when N_Attribute_Reference =>
782 pragma Debug (Indicate_Tested (N_Attribute_Reference));
783
784 if Present (Project_Node_Of (Node, In_Tree))
785 and then Project_Node_Of (Node, In_Tree) /= Project
786 then
787 Output_Name
788 (Name_Of (Project_Node_Of (Node, In_Tree), In_Tree),
789 Indent);
790
791 if Present (Package_Node_Of (Node, In_Tree)) then
792 Write_String (".", Indent);
793 Output_Name
794 (Name_Of (Package_Node_Of (Node, In_Tree), In_Tree),
795 Indent);
796 end if;
797
798 elsif Present (Package_Node_Of (Node, In_Tree)) then
799 Output_Name
800 (Name_Of (Package_Node_Of (Node, In_Tree), In_Tree),
801 Indent);
802
803 else
804 Write_String ("project", Indent);
805 end if;
806
807 Write_String ("'", Indent);
808 Output_Attribute_Name (Name_Of (Node, In_Tree), Indent);
809
810 declare
811 Index : constant Name_Id :=
812 Associative_Array_Index_Of (Node, In_Tree);
813 begin
814 if Index /= No_Name then
815 Write_String (" (", Indent);
816 Output_String (Index, Indent);
817 Write_String (")", Indent);
818 end if;
819 end;
820
821 when N_Case_Construction =>
822 pragma Debug (Indicate_Tested (N_Case_Construction));
823
824 declare
825 Case_Item : Project_Node_Id;
826 Is_Non_Empty : Boolean := False;
827
828 begin
829 Case_Item := First_Case_Item_Of (Node, In_Tree);
830 while Present (Case_Item) loop
831 if Present
832 (First_Declarative_Item_Of (Case_Item, In_Tree))
833 or else not Eliminate_Empty_Case_Constructions
834 then
835 Is_Non_Empty := True;
836 exit;
837 end if;
838
839 Case_Item := Next_Case_Item (Case_Item, In_Tree);
840 end loop;
841
842 if Is_Non_Empty then
843 Write_Empty_Line;
844 Print (First_Comment_Before (Node, In_Tree), Indent);
845 Start_Line (Indent);
846 Write_String ("case ", Indent);
847 Print
848 (Case_Variable_Reference_Of (Node, In_Tree), Indent);
849 Write_String (" is", Indent);
850 Write_End_Of_Line_Comment (Node);
851 Print
852 (First_Comment_After (Node, In_Tree),
853 Indent + Increment);
854
855 declare
856 Case_Item : Project_Node_Id :=
857 First_Case_Item_Of (Node, In_Tree);
858 begin
859 while Present (Case_Item) loop
860 pragma Assert
861 (Kind_Of (Case_Item, In_Tree) = N_Case_Item);
862 Print (Case_Item, Indent + Increment);
863 Case_Item :=
864 Next_Case_Item (Case_Item, In_Tree);
865 end loop;
866 end;
867
868 Print (First_Comment_Before_End (Node, In_Tree),
869 Indent + Increment);
870 Start_Line (Indent);
871 Write_Line ("end case;");
872 Print
873 (First_Comment_After_End (Node, In_Tree), Indent);
874 end if;
875 end;
876
877 when N_Case_Item =>
878 pragma Debug (Indicate_Tested (N_Case_Item));
879
880 if Present (First_Declarative_Item_Of (Node, In_Tree))
881 or else not Eliminate_Empty_Case_Constructions
882 then
883 Write_Empty_Line;
884 Print (First_Comment_Before (Node, In_Tree), Indent);
885 Start_Line (Indent);
886 Write_String ("when ", Indent);
887
888 if No (First_Choice_Of (Node, In_Tree)) then
889 Write_String ("others", Indent);
890
891 else
892 declare
893 Label : Project_Node_Id :=
894 First_Choice_Of (Node, In_Tree);
895
896 begin
897 while Present (Label) loop
898 Print (Label, Indent);
899 Label := Next_Literal_String (Label, In_Tree);
900
901 if Present (Label) then
902 Write_String (" | ", Indent);
903 end if;
904 end loop;
905 end;
906 end if;
907
908 Write_String (" =>", Indent);
909 Write_End_Of_Line_Comment (Node);
910 Print
911 (First_Comment_After (Node, In_Tree),
912 Indent + Increment);
913
914 declare
915 First : constant Project_Node_Id :=
916 First_Declarative_Item_Of (Node, In_Tree);
917 begin
918 if No (First) then
919 Write_Empty_Line;
920 else
921 Print (First, Indent + Increment);
922 end if;
923 end;
924 end if;
925
926 when N_Comment_Zones =>
927
928 -- Nothing to do, because it will not be processed directly
929
930 null;
931
932 when N_Comment =>
933 pragma Debug (Indicate_Tested (N_Comment));
934
935 if Follows_Empty_Line (Node, In_Tree) then
936 Write_Empty_Line;
937 end if;
938
939 Start_Line (Indent);
940 Write_String ("--", Indent);
941 Write_String
942 (Get_Name_String (String_Value_Of (Node, In_Tree)),
943 Indent,
944 Truncated => True);
945 Write_Line ("");
946
947 if Is_Followed_By_Empty_Line (Node, In_Tree) then
948 Write_Empty_Line;
949 end if;
950
951 Print (Next_Comment (Node, In_Tree), Indent);
952 end case;
953 end if;
954 end Print;
955
956 -- Start of processing for Pretty_Print
957
958 begin
959 if W_Char = null then
960 Write_Char := Output.Write_Char'Access;
961 else
962 Write_Char := W_Char;
963 end if;
964
965 if W_Eol = null then
966 Write_Eol := Output.Write_Eol'Access;
967 else
968 Write_Eol := W_Eol;
969 end if;
970
971 if W_Str = null then
972 Write_Str := Output.Write_Str'Access;
973 else
974 Write_Str := W_Str;
975 end if;
976
977 Print (Project, 0);
978 end Pretty_Print;
979
980 -----------------------
981 -- Output_Statistics --
982 -----------------------
983
984 procedure Output_Statistics is
985 begin
986 Output.Write_Line ("Project_Node_Kinds not tested:");
987
988 for Kind in Project_Node_Kind loop
989 if Kind /= N_Comment_Zones and then Not_Tested (Kind) then
990 Output.Write_Str (" ");
991 Output.Write_Line (Project_Node_Kind'Image (Kind));
992 end if;
993 end loop;
994
995 Output.Write_Eol;
996 end Output_Statistics;
997
998 ---------
999 -- wpr --
1000 ---------
1001
1002 procedure wpr
1003 (Project : Prj.Tree.Project_Node_Id;
1004 In_Tree : Prj.Tree.Project_Node_Tree_Ref)
1005 is
1006 begin
1007 Pretty_Print (Project, In_Tree, Backward_Compatibility => False);
1008 end wpr;
1009
1010 end Prj.PP;
Mirror of the offical gcc git repository hosted at gcc.gnu.org