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