?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
2010-07-27 Paolo Carlini <paolo.carlini@oracle.com>
[official-gcc/alias-decl.git] / gcc / ada / prj-pp.adb
blobd318c1192c56900c5d32a7b153280f0c23e1a062
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- P R J . P P --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 2001-2009, 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 -- outputting 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 Id : Prj.Project_Id := Prj.No_Project)
78 is
79 procedure Print (Node : Project_Node_Id; Indent : Natural);
80 -- A recursive procedure that traverses a project file tree and outputs
81 -- its source. Current_Prj is the project that we are printing. This
82 -- is used when printing attributes, since in nested packages they
83 -- need to use a fully qualified name.
84
85 procedure Output_Attribute_Name (Name : Name_Id);
86 -- Outputs an attribute name, taking into account the value of
87 -- Backward_Compatibility.
88
89 procedure Output_Name (Name : Name_Id; Capitalize : Boolean := True);
90 -- Outputs a name
91
92 procedure Start_Line (Indent : Natural);
93 -- Outputs the indentation at the beginning of the line
94
95 procedure Output_String (S : Name_Id);
96 procedure Output_String (S : Path_Name_Type);
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 procedure Output_String (S : Path_Name_Type) is
233 begin
234 Output_String (Name_Id (S));
235 end Output_String;
236
237 ----------------
238 -- Start_Line --
239 ----------------
240
241 procedure Start_Line (Indent : Natural) is
242 begin
243 if not Minimize_Empty_Lines then
244 Write_Str ((1 .. Indent => ' '));
245 Column := Column + Indent;
246 end if;
247 end Start_Line;
248
249 ----------------------
250 -- Write_Empty_Line --
251 ----------------------
252
253 procedure Write_Empty_Line (Always : Boolean := False) is
254 begin
255 if (Always or else not Minimize_Empty_Lines)
256 and then not Last_Line_Is_Empty then
257 Write_Eol.all;
258 Column := 0;
259 Last_Line_Is_Empty := True;
260 end if;
261 end Write_Empty_Line;
262
263 -------------------------------
264 -- Write_End_Of_Line_Comment --
265 -------------------------------
266
267 procedure Write_End_Of_Line_Comment (Node : Project_Node_Id) is
268 Value : constant Name_Id := End_Of_Line_Comment (Node, In_Tree);
269
270 begin
271 if Value /= No_Name then
272 Write_String (" --");
273 Write_String (Get_Name_String (Value), Truncated => True);
274 end if;
275
276 Write_Line ("");
277 end Write_End_Of_Line_Comment;
278
279 ----------------
280 -- Write_Line --
281 ----------------
282
283 procedure Write_Line (S : String) is
284 begin
285 Write_String (S);
286 Last_Line_Is_Empty := False;
287 Write_Eol.all;
288 Column := 0;
289 end Write_Line;
290
291 ------------------
292 -- Write_String --
293 ------------------
294
295 procedure Write_String (S : String; Truncated : Boolean := False) is
296 Length : Natural := S'Length;
297 begin
298 -- If the string would not fit on the line,
299 -- start a new line.
300
301 if Column + Length > Max_Line_Length then
302 if Truncated then
303 Length := Max_Line_Length - Column;
304
305 else
306 Write_Eol.all;
307 Column := 0;
308 end if;
309 end if;
310
311 Write_Str (S (S'First .. S'First + Length - 1));
312 Column := Column + Length;
313 end Write_String;
314
315 -----------
316 -- Print --
317 -----------
318
319 procedure Print (Node : Project_Node_Id; Indent : Natural) is
320 begin
321 if Present (Node) then
322
323 case Kind_Of (Node, In_Tree) is
324
325 when N_Project =>
326 pragma Debug (Indicate_Tested (N_Project));
327 if Present (First_With_Clause_Of (Node, In_Tree)) then
328
329 -- with clause(s)
330
331 First_With_In_List := True;
332 Print (First_With_Clause_Of (Node, In_Tree), Indent);
333 Write_Empty_Line (Always => True);
334 end if;
335
336 Print (First_Comment_Before (Node, In_Tree), Indent);
337 Start_Line (Indent);
338 Write_String ("project ");
339
340 if Id /= Prj.No_Project then
341 Output_Name (Id.Display_Name);
342 else
343 Output_Name (Name_Of (Node, In_Tree));
344 end if;
345
346 -- Check if this project extends another project
347
348 if Extended_Project_Path_Of (Node, In_Tree) /= No_Path then
349 Write_String (" extends ");
350
351 if Is_Extending_All (Node, In_Tree) then
352 Write_String ("all ");
353 end if;
354
355 Output_String (Extended_Project_Path_Of (Node, In_Tree));
356 end if;
357
358 Write_String (" is");
359 Write_End_Of_Line_Comment (Node);
360 Print
361 (First_Comment_After (Node, In_Tree), Indent + Increment);
362 Write_Empty_Line (Always => True);
363
364 -- Output all of the declarations in the project
365
366 Print (Project_Declaration_Of (Node, In_Tree), Indent);
367 Print
368 (First_Comment_Before_End (Node, In_Tree),
369 Indent + Increment);
370 Start_Line (Indent);
371 Write_String ("end ");
372
373 if Id /= Prj.No_Project then
374 Output_Name (Id.Display_Name);
375 else
376 Output_Name (Name_Of (Node, In_Tree));
377 end if;
378
379 Write_Line (";");
380 Print (First_Comment_After_End (Node, In_Tree), Indent);
381
382 when N_With_Clause =>
383 pragma Debug (Indicate_Tested (N_With_Clause));
384
385 -- The with clause will sometimes contain an invalid name
386 -- when we are importing a virtual project from an
387 -- extending all project. Do not output anything in this
388 -- case
389
390 if Name_Of (Node, In_Tree) /= No_Name
391 and then String_Value_Of (Node, In_Tree) /= No_Name
392 then
393 if First_With_In_List then
394 Print (First_Comment_Before (Node, In_Tree), Indent);
395 Start_Line (Indent);
396
397 if Non_Limited_Project_Node_Of (Node, In_Tree) =
398 Empty_Node
399 then
400 Write_String ("limited ");
401 end if;
402
403 Write_String ("with ");
404 end if;
405
406 Output_String (String_Value_Of (Node, In_Tree));
407
408 if Is_Not_Last_In_List (Node, In_Tree) then
409 Write_String (", ");
410 First_With_In_List := False;
411
412 else
413 Write_String (";");
414 Write_End_Of_Line_Comment (Node);
415 Print (First_Comment_After (Node, In_Tree), Indent);
416 First_With_In_List := True;
417 end if;
418 end if;
419
420 Print (Next_With_Clause_Of (Node, In_Tree), Indent);
421
422 when N_Project_Declaration =>
423 pragma Debug (Indicate_Tested (N_Project_Declaration));
424
425 if
426 Present (First_Declarative_Item_Of (Node, In_Tree))
427 then
428 Print
429 (First_Declarative_Item_Of (Node, In_Tree),
430 Indent + Increment);
431 Write_Empty_Line (Always => True);
432 end if;
433
434 when N_Declarative_Item =>
435 pragma Debug (Indicate_Tested (N_Declarative_Item));
436 Print (Current_Item_Node (Node, In_Tree), Indent);
437 Print (Next_Declarative_Item (Node, In_Tree), Indent);
438
439 when N_Package_Declaration =>
440 pragma Debug (Indicate_Tested (N_Package_Declaration));
441 Write_Empty_Line (Always => True);
442 Print (First_Comment_Before (Node, In_Tree), Indent);
443 Start_Line (Indent);
444 Write_String ("package ");
445 Output_Name (Name_Of (Node, In_Tree));
446
447 if Project_Of_Renamed_Package_Of (Node, In_Tree) /=
448 Empty_Node
449 then
450 Write_String (" renames ");
451 Output_Name
452 (Name_Of
453 (Project_Of_Renamed_Package_Of (Node, In_Tree),
454 In_Tree));
455 Write_String (".");
456 Output_Name (Name_Of (Node, In_Tree));
457 Write_String (";");
458 Write_End_Of_Line_Comment (Node);
459 Print (First_Comment_After_End (Node, In_Tree), Indent);
460
461 else
462 Write_String (" is");
463 Write_End_Of_Line_Comment (Node);
464 Print (First_Comment_After (Node, In_Tree),
465 Indent + Increment);
466
467 if First_Declarative_Item_Of (Node, In_Tree) /=
468 Empty_Node
469 then
470 Print
471 (First_Declarative_Item_Of (Node, In_Tree),
472 Indent + Increment);
473 end if;
474
475 Print (First_Comment_Before_End (Node, In_Tree),
476 Indent + Increment);
477 Start_Line (Indent);
478 Write_String ("end ");
479 Output_Name (Name_Of (Node, In_Tree));
480 Write_Line (";");
481 Print (First_Comment_After_End (Node, In_Tree), Indent);
482 Write_Empty_Line;
483 end if;
484
485 when N_String_Type_Declaration =>
486 pragma Debug (Indicate_Tested (N_String_Type_Declaration));
487 Print (First_Comment_Before (Node, In_Tree), Indent);
488 Start_Line (Indent);
489 Write_String ("type ");
490 Output_Name (Name_Of (Node, In_Tree));
491 Write_Line (" is");
492 Start_Line (Indent + Increment);
493 Write_String ("(");
494
495 declare
496 String_Node : Project_Node_Id :=
497 First_Literal_String (Node, In_Tree);
498
499 begin
500 while Present (String_Node) loop
501 Output_String (String_Value_Of (String_Node, In_Tree));
502 String_Node :=
503 Next_Literal_String (String_Node, In_Tree);
504
505 if Present (String_Node) then
506 Write_String (", ");
507 end if;
508 end loop;
509 end;
510
511 Write_String (");");
512 Write_End_Of_Line_Comment (Node);
513 Print (First_Comment_After (Node, In_Tree), Indent);
514
515 when N_Literal_String =>
516 pragma Debug (Indicate_Tested (N_Literal_String));
517 Output_String (String_Value_Of (Node, In_Tree));
518
519 if Source_Index_Of (Node, In_Tree) /= 0 then
520 Write_String (" at");
521 Write_String (Source_Index_Of (Node, In_Tree)'Img);
522 end if;
523
524 when N_Attribute_Declaration =>
525 pragma Debug (Indicate_Tested (N_Attribute_Declaration));
526 Print (First_Comment_Before (Node, In_Tree), Indent);
527 Start_Line (Indent);
528 Write_String ("for ");
529 Output_Attribute_Name (Name_Of (Node, In_Tree));
530
531 if Associative_Array_Index_Of (Node, In_Tree) /= No_Name then
532 Write_String (" (");
533 Output_String
534 (Associative_Array_Index_Of (Node, In_Tree));
535
536 if Source_Index_Of (Node, In_Tree) /= 0 then
537 Write_String (" at");
538 Write_String (Source_Index_Of (Node, In_Tree)'Img);
539 end if;
540
541 Write_String (")");
542 end if;
543
544 Write_String (" use ");
545
546 if Present (Expression_Of (Node, In_Tree)) then
547 Print (Expression_Of (Node, In_Tree), Indent);
548
549 else
550 -- Full associative array declaration
551
552 if
553 Present (Associative_Project_Of (Node, In_Tree))
554 then
555 Output_Name
556 (Name_Of
557 (Associative_Project_Of (Node, In_Tree),
558 In_Tree));
559
560 if
561 Present (Associative_Package_Of (Node, In_Tree))
562 then
563 Write_String (".");
564 Output_Name
565 (Name_Of
566 (Associative_Package_Of (Node, In_Tree),
567 In_Tree));
568 end if;
569
570 elsif
571 Present (Associative_Package_Of (Node, In_Tree))
572 then
573 Output_Name
574 (Name_Of
575 (Associative_Package_Of (Node, In_Tree),
576 In_Tree));
577 end if;
578
579 Write_String ("'");
580 Output_Attribute_Name (Name_Of (Node, In_Tree));
581 end if;
582
583 Write_String (";");
584 Write_End_Of_Line_Comment (Node);
585 Print (First_Comment_After (Node, In_Tree), Indent);
586
587 when N_Typed_Variable_Declaration =>
588 pragma Debug
589 (Indicate_Tested (N_Typed_Variable_Declaration));
590 Print (First_Comment_Before (Node, In_Tree), Indent);
591 Start_Line (Indent);
592 Output_Name (Name_Of (Node, In_Tree));
593 Write_String (" : ");
594 Output_Name
595 (Name_Of (String_Type_Of (Node, In_Tree), In_Tree));
596 Write_String (" := ");
597 Print (Expression_Of (Node, In_Tree), Indent);
598 Write_String (";");
599 Write_End_Of_Line_Comment (Node);
600 Print (First_Comment_After (Node, In_Tree), Indent);
601
602 when N_Variable_Declaration =>
603 pragma Debug (Indicate_Tested (N_Variable_Declaration));
604 Print (First_Comment_Before (Node, In_Tree), Indent);
605 Start_Line (Indent);
606 Output_Name (Name_Of (Node, In_Tree));
607 Write_String (" := ");
608 Print (Expression_Of (Node, In_Tree), Indent);
609 Write_String (";");
610 Write_End_Of_Line_Comment (Node);
611 Print (First_Comment_After (Node, In_Tree), Indent);
612
613 when N_Expression =>
614 pragma Debug (Indicate_Tested (N_Expression));
615 declare
616 Term : Project_Node_Id := First_Term (Node, In_Tree);
617
618 begin
619 while Present (Term) loop
620 Print (Term, Indent);
621 Term := Next_Term (Term, In_Tree);
622
623 if Present (Term) then
624 Write_String (" & ");
625 end if;
626 end loop;
627 end;
628
629 when N_Term =>
630 pragma Debug (Indicate_Tested (N_Term));
631 Print (Current_Term (Node, In_Tree), Indent);
632
633 when N_Literal_String_List =>
634 pragma Debug (Indicate_Tested (N_Literal_String_List));
635 Write_String ("(");
636
637 declare
638 Expression : Project_Node_Id :=
639 First_Expression_In_List (Node, In_Tree);
640
641 begin
642 while Present (Expression) loop
643 Print (Expression, Indent);
644 Expression :=
645 Next_Expression_In_List (Expression, In_Tree);
646
647 if Present (Expression) then
648 Write_String (", ");
649 end if;
650 end loop;
651 end;
652
653 Write_String (")");
654
655 when N_Variable_Reference =>
656 pragma Debug (Indicate_Tested (N_Variable_Reference));
657 if Present (Project_Node_Of (Node, In_Tree)) then
658 Output_Name
659 (Name_Of (Project_Node_Of (Node, In_Tree), In_Tree));
660 Write_String (".");
661 end if;
662
663 if Present (Package_Node_Of (Node, In_Tree)) then
664 Output_Name
665 (Name_Of (Package_Node_Of (Node, In_Tree), In_Tree));
666 Write_String (".");
667 end if;
668
669 Output_Name (Name_Of (Node, In_Tree));
670
671 when N_External_Value =>
672 pragma Debug (Indicate_Tested (N_External_Value));
673 Write_String ("external (");
674 Print (External_Reference_Of (Node, In_Tree), Indent);
675
676 if Present (External_Default_Of (Node, In_Tree)) then
677 Write_String (", ");
678 Print (External_Default_Of (Node, In_Tree), Indent);
679 end if;
680
681 Write_String (")");
682
683 when N_Attribute_Reference =>
684 pragma Debug (Indicate_Tested (N_Attribute_Reference));
685
686 if Present (Project_Node_Of (Node, In_Tree))
687 and then Project_Node_Of (Node, In_Tree) /= Project
688 then
689 Output_Name
690 (Name_Of (Project_Node_Of (Node, In_Tree), In_Tree));
691
692 if Present (Package_Node_Of (Node, In_Tree)) then
693 Write_String (".");
694 Output_Name
695 (Name_Of (Package_Node_Of (Node, In_Tree), In_Tree));
696 end if;
697
698 elsif Present (Package_Node_Of (Node, In_Tree)) then
699 Output_Name
700 (Name_Of (Package_Node_Of (Node, In_Tree), In_Tree));
701
702 else
703 Write_String ("project");
704 end if;
705
706 Write_String ("'");
707 Output_Attribute_Name (Name_Of (Node, In_Tree));
708
709 declare
710 Index : constant Name_Id :=
711 Associative_Array_Index_Of (Node, In_Tree);
712
713 begin
714 if Index /= No_Name then
715 Write_String (" (");
716 Output_String (Index);
717 Write_String (")");
718 end if;
719 end;
720
721 when N_Case_Construction =>
722 pragma Debug (Indicate_Tested (N_Case_Construction));
723
724 declare
725 Case_Item : Project_Node_Id;
726 Is_Non_Empty : Boolean := False;
727
728 begin
729 Case_Item := First_Case_Item_Of (Node, In_Tree);
730 while Present (Case_Item) loop
731 if Present
732 (First_Declarative_Item_Of (Case_Item, In_Tree))
733 or else not Eliminate_Empty_Case_Constructions
734 then
735 Is_Non_Empty := True;
736 exit;
737 end if;
738
739 Case_Item := Next_Case_Item (Case_Item, In_Tree);
740 end loop;
741
742 if Is_Non_Empty then
743 Write_Empty_Line;
744 Print (First_Comment_Before (Node, In_Tree), Indent);
745 Start_Line (Indent);
746 Write_String ("case ");
747 Print
748 (Case_Variable_Reference_Of (Node, In_Tree),
749 Indent);
750 Write_String (" is");
751 Write_End_Of_Line_Comment (Node);
752 Print
753 (First_Comment_After (Node, In_Tree),
754 Indent + Increment);
755
756 declare
757 Case_Item : Project_Node_Id :=
758 First_Case_Item_Of (Node, In_Tree);
759 begin
760 while Present (Case_Item) loop
761 pragma Assert
762 (Kind_Of (Case_Item, In_Tree) = N_Case_Item);
763 Print (Case_Item, Indent + Increment);
764 Case_Item :=
765 Next_Case_Item (Case_Item, In_Tree);
766 end loop;
767 end;
768
769 Print (First_Comment_Before_End (Node, In_Tree),
770 Indent + Increment);
771 Start_Line (Indent);
772 Write_Line ("end case;");
773 Print
774 (First_Comment_After_End (Node, In_Tree), Indent);
775 end if;
776 end;
777
778 when N_Case_Item =>
779 pragma Debug (Indicate_Tested (N_Case_Item));
780
781 if Present (First_Declarative_Item_Of (Node, In_Tree))
782 or else not Eliminate_Empty_Case_Constructions
783 then
784 Write_Empty_Line;
785 Print (First_Comment_Before (Node, In_Tree), Indent);
786 Start_Line (Indent);
787 Write_String ("when ");
788
789 if No (First_Choice_Of (Node, In_Tree)) then
790 Write_String ("others");
791
792 else
793 declare
794 Label : Project_Node_Id :=
795 First_Choice_Of (Node, In_Tree);
796 begin
797 while Present (Label) loop
798 Print (Label, Indent);
799 Label := Next_Literal_String (Label, In_Tree);
800
801 if Present (Label) then
802 Write_String (" | ");
803 end if;
804 end loop;
805 end;
806 end if;
807
808 Write_String (" =>");
809 Write_End_Of_Line_Comment (Node);
810 Print
811 (First_Comment_After (Node, In_Tree),
812 Indent + Increment);
813
814 declare
815 First : constant Project_Node_Id :=
816 First_Declarative_Item_Of (Node, In_Tree);
817 begin
818 if No (First) then
819 Write_Empty_Line;
820 else
821 Print (First, Indent + Increment);
822 end if;
823 end;
824 end if;
825
826 when N_Comment_Zones =>
827
828 -- Nothing to do, because it will not be processed directly
829
830 null;
831
832 when N_Comment =>
833 pragma Debug (Indicate_Tested (N_Comment));
834
835 if Follows_Empty_Line (Node, In_Tree) then
836 Write_Empty_Line;
837 end if;
838
839 Start_Line (Indent);
840 Write_String ("--");
841 Write_String
842 (Get_Name_String (String_Value_Of (Node, In_Tree)),
843 Truncated => True);
844 Write_Line ("");
845
846 if Is_Followed_By_Empty_Line (Node, In_Tree) then
847 Write_Empty_Line;
848 end if;
849
850 Print (Next_Comment (Node, In_Tree), Indent);
851 end case;
852 end if;
853 end Print;
854
855 -- Start of processing for Pretty_Print
856
857 begin
858 if W_Char = null then
859 Write_Char := Output.Write_Char'Access;
860 else
861 Write_Char := W_Char;
862 end if;
863
864 if W_Eol = null then
865 Write_Eol := Output.Write_Eol'Access;
866 else
867 Write_Eol := W_Eol;
868 end if;
869
870 if W_Str = null then
871 Write_Str := Output.Write_Str'Access;
872 else
873 Write_Str := W_Str;
874 end if;
875
876 Print (Project, 0);
877
878 if W_Char = null or else W_Str = null then
879 Output.Write_Eol;
880 end if;
881 end Pretty_Print;
882
883 -----------------------
884 -- Output_Statistics --
885 -----------------------
886
887 procedure Output_Statistics is
888 begin
889 Output.Write_Line ("Project_Node_Kinds not tested:");
890
891 for Kind in Project_Node_Kind loop
892 if Kind /= N_Comment_Zones and then Not_Tested (Kind) then
893 Output.Write_Str (" ");
894 Output.Write_Line (Project_Node_Kind'Image (Kind));
895 end if;
896 end loop;
897
898 Output.Write_Eol;
899 end Output_Statistics;
900
901 end Prj.PP;