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