?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
objc/
[official-gcc.git] / gcc / ada / prj-pp.adb
blob597c0dddcae4a6f8233543805aa5b63747379879
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 Output_String (Extended_Project_Path_Of (Node, In_Tree));
341 end if;
342
343 Write_String (" is");
344 Write_End_Of_Line_Comment (Node);
345 Print
346 (First_Comment_After (Node, In_Tree), Indent + Increment);
347 Write_Empty_Line (Always => True);
348
349 -- Output all of the declarations in the project
350
351 Print (Project_Declaration_Of (Node, In_Tree), Indent);
352 Print
353 (First_Comment_Before_End (Node, In_Tree),
354 Indent + Increment);
355 Start_Line (Indent);
356 Write_String ("end ");
357 Output_Name (Name_Of (Node, In_Tree));
358 Write_Line (";");
359 Print (First_Comment_After_End (Node, In_Tree), Indent);
360
361 when N_With_Clause =>
362 pragma Debug (Indicate_Tested (N_With_Clause));
363
364 if Name_Of (Node, In_Tree) /= No_Name then
365 if First_With_In_List then
366 Print (First_Comment_Before (Node, In_Tree), Indent);
367 Start_Line (Indent);
368
369 if Non_Limited_Project_Node_Of (Node, In_Tree) =
370 Empty_Node
371 then
372 Write_String ("limited ");
373 end if;
374
375 Write_String ("with ");
376 end if;
377
378 Output_String (String_Value_Of (Node, In_Tree));
379
380 if Is_Not_Last_In_List (Node, In_Tree) then
381 Write_String (", ");
382 First_With_In_List := False;
383
384 else
385 Write_String (";");
386 Write_End_Of_Line_Comment (Node);
387 Print (First_Comment_After (Node, In_Tree), Indent);
388 First_With_In_List := True;
389 end if;
390 end if;
391
392 Print (Next_With_Clause_Of (Node, In_Tree), Indent);
393
394 when N_Project_Declaration =>
395 pragma Debug (Indicate_Tested (N_Project_Declaration));
396
397 if
398 First_Declarative_Item_Of (Node, In_Tree) /= Empty_Node
399 then
400 Print
401 (First_Declarative_Item_Of (Node, In_Tree),
402 Indent + Increment);
403 Write_Empty_Line (Always => True);
404 end if;
405
406 when N_Declarative_Item =>
407 pragma Debug (Indicate_Tested (N_Declarative_Item));
408 Print (Current_Item_Node (Node, In_Tree), Indent);
409 Print (Next_Declarative_Item (Node, In_Tree), Indent);
410
411 when N_Package_Declaration =>
412 pragma Debug (Indicate_Tested (N_Package_Declaration));
413 Write_Empty_Line (Always => True);
414 Print (First_Comment_Before (Node, In_Tree), Indent);
415 Start_Line (Indent);
416 Write_String ("package ");
417 Output_Name (Name_Of (Node, In_Tree));
418
419 if Project_Of_Renamed_Package_Of (Node, In_Tree) /=
420 Empty_Node
421 then
422 Write_String (" renames ");
423 Output_Name
424 (Name_Of
425 (Project_Of_Renamed_Package_Of (Node, In_Tree),
426 In_Tree));
427 Write_String (".");
428 Output_Name (Name_Of (Node, In_Tree));
429 Write_String (";");
430 Write_End_Of_Line_Comment (Node);
431 Print (First_Comment_After_End (Node, In_Tree), Indent);
432
433 else
434 Write_String (" is");
435 Write_End_Of_Line_Comment (Node);
436 Print (First_Comment_After (Node, In_Tree),
437 Indent + Increment);
438
439 if First_Declarative_Item_Of (Node, In_Tree) /=
440 Empty_Node
441 then
442 Print
443 (First_Declarative_Item_Of (Node, In_Tree),
444 Indent + Increment);
445 end if;
446
447 Print (First_Comment_Before_End (Node, In_Tree),
448 Indent + Increment);
449 Start_Line (Indent);
450 Write_String ("end ");
451 Output_Name (Name_Of (Node, In_Tree));
452 Write_Line (";");
453 Print (First_Comment_After_End (Node, In_Tree), Indent);
454 Write_Empty_Line;
455 end if;
456
457 when N_String_Type_Declaration =>
458 pragma Debug (Indicate_Tested (N_String_Type_Declaration));
459 Print (First_Comment_Before (Node, In_Tree), Indent);
460 Start_Line (Indent);
461 Write_String ("type ");
462 Output_Name (Name_Of (Node, In_Tree));
463 Write_Line (" is");
464 Start_Line (Indent + Increment);
465 Write_String ("(");
466
467 declare
468 String_Node : Project_Node_Id :=
469 First_Literal_String (Node, In_Tree);
470
471 begin
472 while String_Node /= Empty_Node loop
473 Output_String (String_Value_Of (String_Node, In_Tree));
474 String_Node :=
475 Next_Literal_String (String_Node, In_Tree);
476
477 if String_Node /= Empty_Node then
478 Write_String (", ");
479 end if;
480 end loop;
481 end;
482
483 Write_String (");");
484 Write_End_Of_Line_Comment (Node);
485 Print (First_Comment_After (Node, In_Tree), Indent);
486
487 when N_Literal_String =>
488 pragma Debug (Indicate_Tested (N_Literal_String));
489 Output_String (String_Value_Of (Node, In_Tree));
490
491 if Source_Index_Of (Node, In_Tree) /= 0 then
492 Write_String (" at ");
493 Write_String (Source_Index_Of (Node, In_Tree)'Img);
494 end if;
495
496 when N_Attribute_Declaration =>
497 pragma Debug (Indicate_Tested (N_Attribute_Declaration));
498 Print (First_Comment_Before (Node, In_Tree), Indent);
499 Start_Line (Indent);
500 Write_String ("for ");
501 Output_Attribute_Name (Name_Of (Node, In_Tree));
502
503 if Associative_Array_Index_Of (Node, In_Tree) /= No_Name then
504 Write_String (" (");
505 Output_String
506 (Associative_Array_Index_Of (Node, In_Tree));
507
508 if Source_Index_Of (Node, In_Tree) /= 0 then
509 Write_String (" at ");
510 Write_String (Source_Index_Of (Node, In_Tree)'Img);
511 end if;
512
513 Write_String (")");
514 end if;
515
516 Write_String (" use ");
517 Print (Expression_Of (Node, In_Tree), Indent);
518 Write_String (";");
519 Write_End_Of_Line_Comment (Node);
520 Print (First_Comment_After (Node, In_Tree), Indent);
521
522 when N_Typed_Variable_Declaration =>
523 pragma Debug
524 (Indicate_Tested (N_Typed_Variable_Declaration));
525 Print (First_Comment_Before (Node, In_Tree), Indent);
526 Start_Line (Indent);
527 Output_Name (Name_Of (Node, In_Tree));
528 Write_String (" : ");
529 Output_Name
530 (Name_Of (String_Type_Of (Node, In_Tree), In_Tree));
531 Write_String (" := ");
532 Print (Expression_Of (Node, In_Tree), Indent);
533 Write_String (";");
534 Write_End_Of_Line_Comment (Node);
535 Print (First_Comment_After (Node, In_Tree), Indent);
536
537 when N_Variable_Declaration =>
538 pragma Debug (Indicate_Tested (N_Variable_Declaration));
539 Print (First_Comment_Before (Node, In_Tree), Indent);
540 Start_Line (Indent);
541 Output_Name (Name_Of (Node, In_Tree));
542 Write_String (" := ");
543 Print (Expression_Of (Node, In_Tree), Indent);
544 Write_String (";");
545 Write_End_Of_Line_Comment (Node);
546 Print (First_Comment_After (Node, In_Tree), Indent);
547
548 when N_Expression =>
549 pragma Debug (Indicate_Tested (N_Expression));
550 declare
551 Term : Project_Node_Id := First_Term (Node, In_Tree);
552
553 begin
554 while Term /= Empty_Node loop
555 Print (Term, Indent);
556 Term := Next_Term (Term, In_Tree);
557
558 if Term /= Empty_Node then
559 Write_String (" & ");
560 end if;
561 end loop;
562 end;
563
564 when N_Term =>
565 pragma Debug (Indicate_Tested (N_Term));
566 Print (Current_Term (Node, In_Tree), Indent);
567
568 when N_Literal_String_List =>
569 pragma Debug (Indicate_Tested (N_Literal_String_List));
570 Write_String ("(");
571
572 declare
573 Expression : Project_Node_Id :=
574 First_Expression_In_List (Node, In_Tree);
575
576 begin
577 while Expression /= Empty_Node loop
578 Print (Expression, Indent);
579 Expression :=
580 Next_Expression_In_List (Expression, In_Tree);
581
582 if Expression /= Empty_Node then
583 Write_String (", ");
584 end if;
585 end loop;
586 end;
587
588 Write_String (")");
589
590 when N_Variable_Reference =>
591 pragma Debug (Indicate_Tested (N_Variable_Reference));
592 if Project_Node_Of (Node, In_Tree) /= Empty_Node then
593 Output_Name
594 (Name_Of (Project_Node_Of (Node, In_Tree), In_Tree));
595 Write_String (".");
596 end if;
597
598 if Package_Node_Of (Node, In_Tree) /= Empty_Node then
599 Output_Name
600 (Name_Of (Package_Node_Of (Node, In_Tree), In_Tree));
601 Write_String (".");
602 end if;
603
604 Output_Name (Name_Of (Node, In_Tree));
605
606 when N_External_Value =>
607 pragma Debug (Indicate_Tested (N_External_Value));
608 Write_String ("external (");
609 Print (External_Reference_Of (Node, In_Tree), Indent);
610
611 if External_Default_Of (Node, In_Tree) /= Empty_Node then
612 Write_String (", ");
613 Print (External_Default_Of (Node, In_Tree), Indent);
614 end if;
615
616 Write_String (")");
617
618 when N_Attribute_Reference =>
619 pragma Debug (Indicate_Tested (N_Attribute_Reference));
620
621 if Project_Node_Of (Node, In_Tree) /= Empty_Node
622 and then Project_Node_Of (Node, In_Tree) /= Project
623 then
624 Output_Name
625 (Name_Of (Project_Node_Of (Node, In_Tree), In_Tree));
626
627 if Package_Node_Of (Node, In_Tree) /= Empty_Node then
628 Write_String (".");
629 Output_Name
630 (Name_Of (Package_Node_Of (Node, In_Tree), In_Tree));
631 end if;
632
633 elsif Package_Node_Of (Node, In_Tree) /= Empty_Node then
634 Output_Name
635 (Name_Of (Package_Node_Of (Node, In_Tree), In_Tree));
636
637 else
638 Write_String ("project");
639 end if;
640
641 Write_String ("'");
642 Output_Attribute_Name (Name_Of (Node, In_Tree));
643
644 declare
645 Index : constant Name_Id :=
646 Associative_Array_Index_Of (Node, In_Tree);
647
648 begin
649 if Index /= No_Name then
650 Write_String (" (");
651 Output_String (Index);
652 Write_String (")");
653 end if;
654 end;
655
656 when N_Case_Construction =>
657 pragma Debug (Indicate_Tested (N_Case_Construction));
658
659 declare
660 Case_Item : Project_Node_Id;
661 Is_Non_Empty : Boolean := False;
662
663 begin
664 Case_Item := First_Case_Item_Of (Node, In_Tree);
665 while Case_Item /= Empty_Node loop
666 if First_Declarative_Item_Of (Case_Item, In_Tree) /=
667 Empty_Node
668 or else not Eliminate_Empty_Case_Constructions
669 then
670 Is_Non_Empty := True;
671 exit;
672 end if;
673
674 Case_Item := Next_Case_Item (Case_Item, In_Tree);
675 end loop;
676
677 if Is_Non_Empty then
678 Write_Empty_Line;
679 Print (First_Comment_Before (Node, In_Tree), Indent);
680 Start_Line (Indent);
681 Write_String ("case ");
682 Print
683 (Case_Variable_Reference_Of (Node, In_Tree),
684 Indent);
685 Write_String (" is");
686 Write_End_Of_Line_Comment (Node);
687 Print
688 (First_Comment_After (Node, In_Tree),
689 Indent + Increment);
690
691 declare
692 Case_Item : Project_Node_Id :=
693 First_Case_Item_Of (Node, In_Tree);
694 begin
695 while Case_Item /= Empty_Node loop
696 pragma Assert
697 (Kind_Of (Case_Item, In_Tree) = N_Case_Item);
698 Print (Case_Item, Indent + Increment);
699 Case_Item :=
700 Next_Case_Item (Case_Item, In_Tree);
701 end loop;
702 end;
703
704 Print (First_Comment_Before_End (Node, In_Tree),
705 Indent + Increment);
706 Start_Line (Indent);
707 Write_Line ("end case;");
708 Print
709 (First_Comment_After_End (Node, In_Tree), Indent);
710 end if;
711 end;
712
713 when N_Case_Item =>
714 pragma Debug (Indicate_Tested (N_Case_Item));
715
716 if First_Declarative_Item_Of (Node, In_Tree) /= Empty_Node
717 or else not Eliminate_Empty_Case_Constructions
718 then
719 Write_Empty_Line;
720 Print (First_Comment_Before (Node, In_Tree), Indent);
721 Start_Line (Indent);
722 Write_String ("when ");
723
724 if First_Choice_Of (Node, In_Tree) = Empty_Node then
725 Write_String ("others");
726
727 else
728 declare
729 Label : Project_Node_Id :=
730 First_Choice_Of (Node, In_Tree);
731 begin
732 while Label /= Empty_Node loop
733 Print (Label, Indent);
734 Label := Next_Literal_String (Label, In_Tree);
735
736 if Label /= Empty_Node then
737 Write_String (" | ");
738 end if;
739 end loop;
740 end;
741 end if;
742
743 Write_String (" =>");
744 Write_End_Of_Line_Comment (Node);
745 Print
746 (First_Comment_After (Node, In_Tree),
747 Indent + Increment);
748
749 declare
750 First : constant Project_Node_Id :=
751 First_Declarative_Item_Of (Node, In_Tree);
752 begin
753 if First = Empty_Node then
754 Write_Empty_Line;
755 else
756 Print (First, Indent + Increment);
757 end if;
758 end;
759 end if;
760
761 when N_Comment_Zones =>
762
763 -- Nothing to do, because it will not be processed directly
764
765 null;
766
767 when N_Comment =>
768 pragma Debug (Indicate_Tested (N_Comment));
769
770 if Follows_Empty_Line (Node, In_Tree) then
771 Write_Empty_Line;
772 end if;
773
774 Start_Line (Indent);
775 Write_String ("--");
776 Write_String
777 (Get_Name_String (String_Value_Of (Node, In_Tree)),
778 Truncated => True);
779 Write_Line ("");
780
781 if Is_Followed_By_Empty_Line (Node, In_Tree) then
782 Write_Empty_Line;
783 end if;
784
785 Print (Next_Comment (Node, In_Tree), Indent);
786 end case;
787 end if;
788 end Print;
789
790 -- Start of processing for Pretty_Print
791
792 begin
793 if W_Char = null then
794 Write_Char := Output.Write_Char'Access;
795 else
796 Write_Char := W_Char;
797 end if;
798
799 if W_Eol = null then
800 Write_Eol := Output.Write_Eol'Access;
801 else
802 Write_Eol := W_Eol;
803 end if;
804
805 if W_Str = null then
806 Write_Str := Output.Write_Str'Access;
807 else
808 Write_Str := W_Str;
809 end if;
810
811 Print (Project, 0);
812
813 if W_Char = null or else W_Str = null then
814 Output.Write_Eol;
815 end if;
816 end Pretty_Print;
817
818 -----------------------
819 -- Output_Statistics --
820 -----------------------
821
822 procedure Output_Statistics is
823 begin
824 Output.Write_Line ("Project_Node_Kinds not tested:");
825
826 for Kind in Project_Node_Kind loop
827 if Kind /= N_Comment_Zones and then Not_Tested (Kind) then
828 Output.Write_Str (" ");
829 Output.Write_Line (Project_Node_Kind'Image (Kind));
830 end if;
831 end loop;
832
833 Output.Write_Eol;
834 end Output_Statistics;
835
836 end Prj.PP;
Mirror of the offical gcc git repository hosted at gcc.gnu.org