1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2001-2015, Free Software Foundation, Inc. --
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. --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 ------------------------------------------------------------------------------
26 with Ada
.Characters
.Handling
; use Ada
.Characters
.Handling
;
28 with Output
; use Output
;
31 package body Prj
.PP
is
35 Not_Tested
: array (Project_Node_Kind
) of Boolean := (others => True);
37 procedure Indicate_Tested
(Kind
: Project_Node_Kind
);
38 -- Set the corresponding component of array Not_Tested to False. Only
39 -- called by Debug pragmas.
45 procedure Indicate_Tested
(Kind
: Project_Node_Kind
) is
47 Not_Tested
(Kind
) := False;
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)
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.
74 procedure Output_Attribute_Name
(Name
: Name_Id
; Indent
: Natural);
75 -- Outputs an attribute name, taking into account the value of
76 -- Backward_Compatibility.
81 Capitalize
: Boolean := True);
84 procedure Start_Line
(Indent
: Natural);
85 -- Outputs the indentation at the beginning of the line
87 procedure Output_Project_File
(S
: Name_Id
);
88 -- Output a project file name in one single string literal
90 procedure Output_String
(S
: Name_Id
; Indent
: Natural);
91 -- Outputs a string using the default output procedures
93 procedure Write_Empty_Line
(Always
: Boolean := False);
94 -- Outputs an empty line, only if the previous line was not empty
95 -- already and either Always is True or Minimize_Empty_Lines is False.
97 procedure Write_Line
(S
: String);
98 -- Outputs S followed by a new line
100 procedure Write_String
103 Truncated
: Boolean := False);
104 -- Outputs S using Write_Str, starting a new line if line would become
105 -- too long, when Truncated = False. When Truncated = True, only the
106 -- part of the string that can fit on the line is output.
108 procedure Write_End_Of_Line_Comment
(Node
: Project_Node_Id
);
111 Write_Char
: Write_Char_Ap
:= Output
.Write_Char
'Access;
112 Write_Eol
: Write_Eol_Ap
:= Output
.Write_Eol
'Access;
113 Write_Str
: Write_Str_Ap
:= Output
.Write_Str
'Access;
114 -- These three access to procedure values are used for the output
116 Last_Line_Is_Empty
: Boolean := False;
117 -- Used to avoid two consecutive empty lines
119 Column
: Natural := 0;
120 -- Column number of the last character in the line. Used to avoid
121 -- outputting lines longer than Max_Line_Length.
123 First_With_In_List
: Boolean := True;
124 -- Indicate that the next with clause is first in a list such as
126 -- First_With_In_List will be True for "A", but not for "B".
128 ---------------------------
129 -- Output_Attribute_Name --
130 ---------------------------
132 procedure Output_Attribute_Name
(Name
: Name_Id
; Indent
: Natural) is
134 if Backward_Compatibility
then
136 when Snames
.Name_Spec
=>
137 Output_Name
(Snames
.Name_Specification
, Indent
);
139 when Snames
.Name_Spec_Suffix
=>
140 Output_Name
(Snames
.Name_Specification_Suffix
, Indent
);
142 when Snames
.Name_Body
=>
143 Output_Name
(Snames
.Name_Implementation
, Indent
);
145 when Snames
.Name_Body_Suffix
=>
146 Output_Name
(Snames
.Name_Implementation_Suffix
, Indent
);
149 Output_Name
(Name
, Indent
);
153 Output_Name
(Name
, Indent
);
155 end Output_Attribute_Name
;
161 procedure Output_Name
164 Capitalize
: Boolean := True)
166 Capital
: Boolean := Capitalize
;
169 if Column
= 0 and then Indent
/= 0 then
170 Start_Line
(Indent
+ Increment
);
173 Get_Name_String
(Name
);
175 -- If line would become too long, create new line
177 if Column
+ Name_Len
> Max_Line_Length
then
182 Start_Line
(Indent
+ Increment
);
186 for J
in 1 .. Name_Len
loop
188 Write_Char
(To_Upper
(Name_Buffer
(J
)));
190 Write_Char
(Name_Buffer
(J
));
195 Name_Buffer
(J
) = '_'
196 or else Is_Digit
(Name_Buffer
(J
));
200 Column
:= Column
+ Name_Len
;
203 -------------------------
204 -- Output_Project_File --
205 -------------------------
207 procedure Output_Project_File
(S
: Name_Id
) is
208 File_Name
: constant String := Get_Name_String
(S
);
213 for J
in File_Name
'Range loop
214 if File_Name
(J
) = '"' then
218 Write_Char
(File_Name
(J
));
223 end Output_Project_File
;
229 procedure Output_String
(S
: Name_Id
; Indent
: Natural) is
231 if Column
= 0 and then Indent
/= 0 then
232 Start_Line
(Indent
+ Increment
);
237 -- If line could become too long, create new line. Note that the
238 -- number of characters on the line could be twice the number of
239 -- character in the string (if every character is a '"') plus two
240 -- (the initial and final '"').
242 if Column
+ Name_Len
+ Name_Len
+ 2 > Max_Line_Length
then
247 Start_Line
(Indent
+ Increment
);
252 Column
:= Column
+ 1;
255 for J
in 1 .. Name_Len
loop
256 if Name_Buffer
(J
) = '"' then
259 Column
:= Column
+ 2;
261 Write_Char
(Name_Buffer
(J
));
262 Column
:= Column
+ 1;
265 -- If the string does not fit on one line, cut it in parts and
268 if J
< Name_Len
and then Column
>= Max_Line_Length
then
272 Start_Line
(Indent
+ Increment
);
274 Column
:= Column
+ 1;
279 Column
:= Column
+ 1;
286 procedure Start_Line
(Indent
: Natural) is
288 if not Minimize_Empty_Lines
then
289 Write_Str
((1 .. Indent
=> ' '));
290 Column
:= Column
+ Indent
;
294 ----------------------
295 -- Write_Empty_Line --
296 ----------------------
298 procedure Write_Empty_Line
(Always
: Boolean := False) is
300 if (Always
or else not Minimize_Empty_Lines
)
301 and then not Last_Line_Is_Empty
305 Last_Line_Is_Empty
:= True;
307 end Write_Empty_Line
;
309 -------------------------------
310 -- Write_End_Of_Line_Comment --
311 -------------------------------
313 procedure Write_End_Of_Line_Comment
(Node
: Project_Node_Id
) is
314 Value
: constant Name_Id
:= End_Of_Line_Comment
(Node
, In_Tree
);
317 if Value
/= No_Name
then
318 Write_String
(" --", 0);
319 Write_String
(Get_Name_String
(Value
), 0, Truncated
=> True);
323 end Write_End_Of_Line_Comment
;
329 procedure Write_Line
(S
: String) is
332 Last_Line_Is_Empty
:= False;
341 procedure Write_String
344 Truncated
: Boolean := False)
346 Length
: Natural := S
'Length;
349 if Column
= 0 and then Indent
/= 0 then
350 Start_Line
(Indent
+ Increment
);
353 -- If the string would not fit on the line, start a new line
355 if Column
+ Length
> Max_Line_Length
then
357 Length
:= Max_Line_Length
- Column
;
364 Start_Line
(Indent
+ Increment
);
369 Write_Str
(S
(S
'First .. S
'First + Length
- 1));
370 Column
:= Column
+ Length
;
377 procedure Print
(Node
: Project_Node_Id
; Indent
: Natural) is
379 if Present
(Node
) then
380 case Kind_Of
(Node
, In_Tree
) is
382 pragma Debug
(Indicate_Tested
(N_Project
));
383 if Present
(First_With_Clause_Of
(Node
, In_Tree
)) then
387 First_With_In_List
:= True;
388 Print
(First_With_Clause_Of
(Node
, In_Tree
), Indent
);
389 Write_Empty_Line
(Always
=> True);
392 Print
(First_Comment_Before
(Node
, In_Tree
), Indent
);
395 case Project_Qualifier_Of
(Node
, In_Tree
) is
396 when Unspecified | Standard
=>
399 Write_String
("aggregate ", Indent
);
400 when Aggregate_Library
=>
401 Write_String
("aggregate library ", Indent
);
403 Write_String
("library ", Indent
);
404 when Configuration
=>
405 Write_String
("configuration ", Indent
);
406 when Abstract_Project
=>
407 Write_String
("abstract ", Indent
);
410 Write_String
("project ", Indent
);
412 if Id
/= Prj
.No_Project
then
413 Output_Name
(Id
.Display_Name
, Indent
);
415 Output_Name
(Name_Of
(Node
, In_Tree
), Indent
);
418 -- Check if this project extends another project
420 if Extended_Project_Path_Of
(Node
, In_Tree
) /= No_Path
then
421 Write_String
(" extends ", Indent
);
423 if Is_Extending_All
(Node
, In_Tree
) then
424 Write_String
("all ", Indent
);
428 (Name_Id
(Extended_Project_Path_Of
(Node
, In_Tree
)));
431 Write_String
(" is", Indent
);
432 Write_End_Of_Line_Comment
(Node
);
434 (First_Comment_After
(Node
, In_Tree
), Indent
+ Increment
);
435 Write_Empty_Line
(Always
=> True);
437 -- Output all of the declarations in the project
439 Print
(Project_Declaration_Of
(Node
, In_Tree
), Indent
);
441 (First_Comment_Before_End
(Node
, In_Tree
),
444 Write_String
("end ", Indent
);
446 if Id
/= Prj
.No_Project
then
447 Output_Name
(Id
.Display_Name
, Indent
);
449 Output_Name
(Name_Of
(Node
, In_Tree
), Indent
);
453 Print
(First_Comment_After_End
(Node
, In_Tree
), Indent
);
455 when N_With_Clause
=>
456 pragma Debug
(Indicate_Tested
(N_With_Clause
));
458 -- The with clause will sometimes contain an invalid name
459 -- when we are importing a virtual project from an extending
460 -- all project. Do not output anything in this case.
462 if Name_Of
(Node
, In_Tree
) /= No_Name
463 and then String_Value_Of
(Node
, In_Tree
) /= No_Name
465 if First_With_In_List
then
466 Print
(First_Comment_Before
(Node
, In_Tree
), Indent
);
469 if Non_Limited_Project_Node_Of
(Node
, In_Tree
) =
472 Write_String
("limited ", Indent
);
475 Write_String
("with ", Indent
);
478 -- Output the project name without concatenation, even if
479 -- the line is too long.
481 Output_Project_File
(String_Value_Of
(Node
, In_Tree
));
483 if Is_Not_Last_In_List
(Node
, In_Tree
) then
484 Write_String
(", ", Indent
);
485 First_With_In_List
:= False;
488 Write_String
(";", Indent
);
489 Write_End_Of_Line_Comment
(Node
);
490 Print
(First_Comment_After
(Node
, In_Tree
), Indent
);
491 First_With_In_List
:= True;
495 Print
(Next_With_Clause_Of
(Node
, In_Tree
), Indent
);
497 when N_Project_Declaration
=>
498 pragma Debug
(Indicate_Tested
(N_Project_Declaration
));
501 Present
(First_Declarative_Item_Of
(Node
, In_Tree
))
504 (First_Declarative_Item_Of
(Node
, In_Tree
),
506 Write_Empty_Line
(Always
=> True);
509 when N_Declarative_Item
=>
510 pragma Debug
(Indicate_Tested
(N_Declarative_Item
));
511 Print
(Current_Item_Node
(Node
, In_Tree
), Indent
);
512 Print
(Next_Declarative_Item
(Node
, In_Tree
), Indent
);
514 when N_Package_Declaration
=>
515 pragma Debug
(Indicate_Tested
(N_Package_Declaration
));
516 Write_Empty_Line
(Always
=> True);
517 Print
(First_Comment_Before
(Node
, In_Tree
), Indent
);
519 Write_String
("package ", Indent
);
520 Output_Name
(Name_Of
(Node
, In_Tree
), Indent
);
522 if Project_Of_Renamed_Package_Of
(Node
, In_Tree
) /=
525 if First_Declarative_Item_Of
(Node
, In_Tree
) = Empty_Node
527 Write_String
(" renames ", Indent
);
529 Write_String
(" extends ", Indent
);
534 (Project_Of_Renamed_Package_Of
(Node
, In_Tree
),
537 Write_String
(".", Indent
);
538 Output_Name
(Name_Of
(Node
, In_Tree
), Indent
);
541 if Project_Of_Renamed_Package_Of
(Node
, In_Tree
) /=
544 First_Declarative_Item_Of
(Node
, In_Tree
) = Empty_Node
546 Write_String
(";", Indent
);
547 Write_End_Of_Line_Comment
(Node
);
548 Print
(First_Comment_After_End
(Node
, In_Tree
), Indent
);
551 Write_String
(" is", Indent
);
552 Write_End_Of_Line_Comment
(Node
);
553 Print
(First_Comment_After
(Node
, In_Tree
),
556 if First_Declarative_Item_Of
(Node
, In_Tree
) /= Empty_Node
559 (First_Declarative_Item_Of
(Node
, In_Tree
),
563 Print
(First_Comment_Before_End
(Node
, In_Tree
),
566 Write_String
("end ", Indent
);
567 Output_Name
(Name_Of
(Node
, In_Tree
), Indent
);
569 Print
(First_Comment_After_End
(Node
, In_Tree
), Indent
);
573 when N_String_Type_Declaration
=>
574 pragma Debug
(Indicate_Tested
(N_String_Type_Declaration
));
575 Print
(First_Comment_Before
(Node
, In_Tree
), Indent
);
577 Write_String
("type ", Indent
);
578 Output_Name
(Name_Of
(Node
, In_Tree
), Indent
);
580 Start_Line
(Indent
+ Increment
);
581 Write_String
("(", Indent
);
584 String_Node
: Project_Node_Id
:=
585 First_Literal_String
(Node
, In_Tree
);
588 while Present
(String_Node
) loop
590 (String_Value_Of
(String_Node
, In_Tree
), Indent
);
592 Next_Literal_String
(String_Node
, In_Tree
);
594 if Present
(String_Node
) then
595 Write_String
(", ", Indent
);
600 Write_String
(");", Indent
);
601 Write_End_Of_Line_Comment
(Node
);
602 Print
(First_Comment_After
(Node
, In_Tree
), Indent
);
604 when N_Literal_String
=>
605 pragma Debug
(Indicate_Tested
(N_Literal_String
));
606 Output_String
(String_Value_Of
(Node
, In_Tree
), Indent
);
608 if Source_Index_Of
(Node
, In_Tree
) /= 0 then
609 Write_String
(" at", Indent
);
611 (Source_Index_Of
(Node
, In_Tree
)'Img, Indent
);
614 when N_Attribute_Declaration
=>
615 pragma Debug
(Indicate_Tested
(N_Attribute_Declaration
));
616 Print
(First_Comment_Before
(Node
, In_Tree
), Indent
);
618 Write_String
("for ", Indent
);
619 Output_Attribute_Name
(Name_Of
(Node
, In_Tree
), Indent
);
621 if Associative_Array_Index_Of
(Node
, In_Tree
) /= No_Name
then
622 Write_String
(" (", Indent
);
624 (Associative_Array_Index_Of
(Node
, In_Tree
), Indent
);
626 if Source_Index_Of
(Node
, In_Tree
) /= 0 then
627 Write_String
(" at", Indent
);
629 (Source_Index_Of
(Node
, In_Tree
)'Img, Indent
);
632 Write_String
(")", Indent
);
635 Write_String
(" use ", Indent
);
637 if Present
(Expression_Of
(Node
, In_Tree
)) then
638 Print
(Expression_Of
(Node
, In_Tree
), Indent
);
641 -- Full associative array declaration
643 if Present
(Associative_Project_Of
(Node
, In_Tree
)) then
646 (Associative_Project_Of
(Node
, In_Tree
),
650 if Present
(Associative_Package_Of
(Node
, In_Tree
))
652 Write_String
(".", Indent
);
655 (Associative_Package_Of
(Node
, In_Tree
),
660 elsif Present
(Associative_Package_Of
(Node
, In_Tree
))
664 (Associative_Package_Of
(Node
, In_Tree
),
669 Write_String
("'", Indent
);
670 Output_Attribute_Name
(Name_Of
(Node
, In_Tree
), Indent
);
673 Write_String
(";", Indent
);
674 Write_End_Of_Line_Comment
(Node
);
675 Print
(First_Comment_After
(Node
, In_Tree
), Indent
);
677 when N_Typed_Variable_Declaration
=>
679 (Indicate_Tested
(N_Typed_Variable_Declaration
));
680 Print
(First_Comment_Before
(Node
, In_Tree
), Indent
);
682 Output_Name
(Name_Of
(Node
, In_Tree
), Indent
);
683 Write_String
(" : ", Indent
);
685 (Name_Of
(String_Type_Of
(Node
, In_Tree
), In_Tree
),
687 Write_String
(" := ", Indent
);
688 Print
(Expression_Of
(Node
, In_Tree
), Indent
);
689 Write_String
(";", Indent
);
690 Write_End_Of_Line_Comment
(Node
);
691 Print
(First_Comment_After
(Node
, In_Tree
), Indent
);
693 when N_Variable_Declaration
=>
694 pragma Debug
(Indicate_Tested
(N_Variable_Declaration
));
695 Print
(First_Comment_Before
(Node
, In_Tree
), Indent
);
697 Output_Name
(Name_Of
(Node
, In_Tree
), Indent
);
698 Write_String
(" := ", Indent
);
699 Print
(Expression_Of
(Node
, In_Tree
), Indent
);
700 Write_String
(";", Indent
);
701 Write_End_Of_Line_Comment
(Node
);
702 Print
(First_Comment_After
(Node
, In_Tree
), Indent
);
705 pragma Debug
(Indicate_Tested
(N_Expression
));
707 Term
: Project_Node_Id
:= First_Term
(Node
, In_Tree
);
710 while Present
(Term
) loop
711 Print
(Term
, Indent
);
712 Term
:= Next_Term
(Term
, In_Tree
);
714 if Present
(Term
) then
715 Write_String
(" & ", Indent
);
721 pragma Debug
(Indicate_Tested
(N_Term
));
722 Print
(Current_Term
(Node
, In_Tree
), Indent
);
724 when N_Literal_String_List
=>
725 pragma Debug
(Indicate_Tested
(N_Literal_String_List
));
726 Write_String
("(", Indent
);
729 Expression
: Project_Node_Id
:=
730 First_Expression_In_List
(Node
, In_Tree
);
733 while Present
(Expression
) loop
734 Print
(Expression
, Indent
);
736 Next_Expression_In_List
(Expression
, In_Tree
);
738 if Present
(Expression
) then
739 Write_String
(", ", Indent
);
744 Write_String
(")", Indent
);
746 when N_Variable_Reference
=>
747 pragma Debug
(Indicate_Tested
(N_Variable_Reference
));
748 if Present
(Project_Node_Of
(Node
, In_Tree
)) then
750 (Name_Of
(Project_Node_Of
(Node
, In_Tree
), In_Tree
),
752 Write_String
(".", Indent
);
755 if Present
(Package_Node_Of
(Node
, In_Tree
)) then
757 (Name_Of
(Package_Node_Of
(Node
, In_Tree
), In_Tree
),
759 Write_String
(".", Indent
);
762 Output_Name
(Name_Of
(Node
, In_Tree
), Indent
);
764 when N_External_Value
=>
765 pragma Debug
(Indicate_Tested
(N_External_Value
));
766 Write_String
("external (", Indent
);
767 Print
(External_Reference_Of
(Node
, In_Tree
), Indent
);
769 if Present
(External_Default_Of
(Node
, In_Tree
)) then
770 Write_String
(", ", Indent
);
771 Print
(External_Default_Of
(Node
, In_Tree
), Indent
);
774 Write_String
(")", Indent
);
776 when N_Attribute_Reference
=>
777 pragma Debug
(Indicate_Tested
(N_Attribute_Reference
));
779 if Present
(Project_Node_Of
(Node
, In_Tree
))
780 and then Project_Node_Of
(Node
, In_Tree
) /= Project
783 (Name_Of
(Project_Node_Of
(Node
, In_Tree
), In_Tree
),
786 if Present
(Package_Node_Of
(Node
, In_Tree
)) then
787 Write_String
(".", Indent
);
789 (Name_Of
(Package_Node_Of
(Node
, In_Tree
), In_Tree
),
793 elsif Present
(Package_Node_Of
(Node
, In_Tree
)) then
795 (Name_Of
(Package_Node_Of
(Node
, In_Tree
), In_Tree
),
799 Write_String
("project", Indent
);
802 Write_String
("'", Indent
);
803 Output_Attribute_Name
(Name_Of
(Node
, In_Tree
), Indent
);
806 Index
: constant Name_Id
:=
807 Associative_Array_Index_Of
(Node
, In_Tree
);
809 if Index
/= No_Name
then
810 Write_String
(" (", Indent
);
811 Output_String
(Index
, Indent
);
812 Write_String
(")", Indent
);
816 when N_Case_Construction
=>
817 pragma Debug
(Indicate_Tested
(N_Case_Construction
));
820 Case_Item
: Project_Node_Id
;
821 Is_Non_Empty
: Boolean := False;
824 Case_Item
:= First_Case_Item_Of
(Node
, In_Tree
);
825 while Present
(Case_Item
) loop
827 (First_Declarative_Item_Of
(Case_Item
, In_Tree
))
828 or else not Eliminate_Empty_Case_Constructions
830 Is_Non_Empty
:= True;
834 Case_Item
:= Next_Case_Item
(Case_Item
, In_Tree
);
839 Print
(First_Comment_Before
(Node
, In_Tree
), Indent
);
841 Write_String
("case ", Indent
);
843 (Case_Variable_Reference_Of
(Node
, In_Tree
), Indent
);
844 Write_String
(" is", Indent
);
845 Write_End_Of_Line_Comment
(Node
);
847 (First_Comment_After
(Node
, In_Tree
),
851 Case_Item
: Project_Node_Id
:=
852 First_Case_Item_Of
(Node
, In_Tree
);
854 while Present
(Case_Item
) loop
856 (Kind_Of
(Case_Item
, In_Tree
) = N_Case_Item
);
857 Print
(Case_Item
, Indent
+ Increment
);
859 Next_Case_Item
(Case_Item
, In_Tree
);
863 Print
(First_Comment_Before_End
(Node
, In_Tree
),
866 Write_Line
("end case;");
868 (First_Comment_After_End
(Node
, In_Tree
), Indent
);
873 pragma Debug
(Indicate_Tested
(N_Case_Item
));
875 if Present
(First_Declarative_Item_Of
(Node
, In_Tree
))
876 or else not Eliminate_Empty_Case_Constructions
879 Print
(First_Comment_Before
(Node
, In_Tree
), Indent
);
881 Write_String
("when ", Indent
);
883 if No
(First_Choice_Of
(Node
, In_Tree
)) then
884 Write_String
("others", Indent
);
888 Label
: Project_Node_Id
:=
889 First_Choice_Of
(Node
, In_Tree
);
892 while Present
(Label
) loop
893 Print
(Label
, Indent
);
894 Label
:= Next_Literal_String
(Label
, In_Tree
);
896 if Present
(Label
) then
897 Write_String
(" | ", Indent
);
903 Write_String
(" =>", Indent
);
904 Write_End_Of_Line_Comment
(Node
);
906 (First_Comment_After
(Node
, In_Tree
),
910 First
: constant Project_Node_Id
:=
911 First_Declarative_Item_Of
(Node
, In_Tree
);
916 Print
(First
, Indent
+ Increment
);
921 when N_Comment_Zones
=>
923 -- Nothing to do, because it will not be processed directly
928 pragma Debug
(Indicate_Tested
(N_Comment
));
930 if Follows_Empty_Line
(Node
, In_Tree
) then
935 Write_String
("--", Indent
);
937 (Get_Name_String
(String_Value_Of
(Node
, In_Tree
)),
942 if Is_Followed_By_Empty_Line
(Node
, In_Tree
) then
946 Print
(Next_Comment
(Node
, In_Tree
), Indent
);
951 -- Start of processing for Pretty_Print
954 if W_Char
= null then
955 Write_Char
:= Output
.Write_Char
'Access;
957 Write_Char
:= W_Char
;
961 Write_Eol
:= Output
.Write_Eol
'Access;
967 Write_Str
:= Output
.Write_Str
'Access;
975 -----------------------
976 -- Output_Statistics --
977 -----------------------
979 procedure Output_Statistics
is
981 Output
.Write_Line
("Project_Node_Kinds not tested:");
983 for Kind
in Project_Node_Kind
loop
984 if Kind
/= N_Comment_Zones
and then Not_Tested
(Kind
) then
985 Output
.Write_Str
(" ");
986 Output
.Write_Line
(Project_Node_Kind
'Image (Kind
));
991 end Output_Statistics
;
998 (Project
: Prj
.Tree
.Project_Node_Id
;
999 In_Tree
: Prj
.Tree
.Project_Node_Tree_Ref
)
1002 Pretty_Print
(Project
, In_Tree
, Backward_Compatibility
=> False);