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