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