-- --
-- B o d y --
-- --
--- Copyright (C) 2001-2013, Free Software Foundation, Inc. --
+-- Copyright (C) 2001-2014, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
Not_Tested : array (Project_Node_Kind) of Boolean := (others => True);
procedure Indicate_Tested (Kind : Project_Node_Kind);
- -- Set the corresponding component of array Not_Tested to False.
- -- Only called by pragmas Debug.
+ -- Set the corresponding component of array Not_Tested to False. Only
+ -- called by Debug pragmas.
---------------------
-- Indicate_Tested --
procedure Start_Line (Indent : Natural);
-- Outputs the indentation at the beginning of the line
+ procedure Output_Project_File (S : Name_Id);
+ -- Output a string for a project file name. No concatenation even if the
+ -- line is too long. What does that mean???
+
procedure Output_String (S : Name_Id; Indent : Natural);
- procedure Output_String (S : Path_Name_Type; Indent : Natural);
-- Outputs a string using the default output procedures
procedure Write_Empty_Line (Always : Boolean := False);
-- Outputs an empty line, only if the previous line was not empty
- -- already and either Always is True or Minimize_Empty_Lines is
- -- False.
+ -- already and either Always is True or Minimize_Empty_Lines is False.
procedure Write_Line (S : String);
-- Outputs S followed by a new line
(S : String;
Indent : Natural;
Truncated : Boolean := False);
- -- Outputs S using Write_Str, starting a new line if line would
- -- become too long, when Truncated = False.
- -- When Truncated = True, only the part of the string that can fit on
- -- the line is output.
+ -- Outputs S using Write_Str, starting a new line if line would become
+ -- too long, when Truncated = False. When Truncated = True, only the
+ -- part of the string that can fit on the line is output.
procedure Write_End_Of_Line_Comment (Node : Project_Node_Id);
+ -- Needs comment???
Write_Char : Write_Char_Ap := Output.Write_Char'Access;
Write_Eol : Write_Eol_Ap := Output.Write_Eol'Access;
Column := Column + Name_Len;
end Output_Name;
+ -------------------------
+ -- Output_Project_File --
+ -------------------------
+
+ procedure Output_Project_File (S : Name_Id) is
+ File_Name : constant String := Get_Name_String (S);
+
+ begin
+ Write_Char ('"');
+
+ for J in File_Name'Range loop
+ if File_Name (J) = '"' then
+ Write_Char ('"');
+ Write_Char ('"');
+ else
+ Write_Char (File_Name (J));
+ end if;
+ end loop;
+
+ Write_Char ('"');
+ end Output_Project_File;
+
-------------------
-- Output_String --
-------------------
Column := Column + 1;
end Output_String;
- procedure Output_String (S : Path_Name_Type; Indent : Natural) is
- begin
- Output_String (Name_Id (S), Indent);
- end Output_String;
-
----------------
-- Start_Line --
----------------
procedure Write_String
(S : String;
Indent : Natural;
- Truncated : Boolean := False) is
+ Truncated : Boolean := False)
+ is
Length : Natural := S'Length;
+
begin
if Column = 0 and then Indent /= 0 then
Start_Line (Indent + Increment);
end if;
- -- If the string would not fit on the line,
- -- start a new line.
+ -- If the string would not fit on the line, start a new line
if Column + Length > Max_Line_Length then
if Truncated then
procedure Print (Node : Project_Node_Id; Indent : Natural) is
begin
if Present (Node) then
-
case Kind_Of (Node, In_Tree) is
-
when N_Project =>
pragma Debug (Indicate_Tested (N_Project));
if Present (First_With_Clause_Of (Node, In_Tree)) then
Write_String ("all ", Indent);
end if;
- Output_String
- (Extended_Project_Path_Of (Node, In_Tree),
- Indent);
+ Output_Project_File
+ (Name_Id (Extended_Project_Path_Of (Node, In_Tree)));
end if;
Write_String (" is", Indent);
pragma Debug (Indicate_Tested (N_With_Clause));
-- The with clause will sometimes contain an invalid name
- -- when we are importing a virtual project from an
- -- extending all project. Do not output anything in this
- -- case
+ -- when we are importing a virtual project from an extending
+ -- all project. Do not output anything in this case.
if Name_Of (Node, In_Tree) /= No_Name
and then String_Value_Of (Node, In_Tree) /= No_Name
Write_String ("with ", Indent);
end if;
- Output_String (String_Value_Of (Node, In_Tree), Indent);
+ -- Output the project name without concatenation, even if
+ -- the line is too long.
+
+ Output_Project_File (String_Value_Of (Node, In_Tree));
if Is_Not_Last_In_List (Node, In_Tree) then
Write_String (", ", Indent);
Print (First_Comment_After (Node, In_Tree),
Indent + Increment);
- if First_Declarative_Item_Of (Node, In_Tree) /=
- Empty_Node
+ if First_Declarative_Item_Of (Node, In_Tree) /= Empty_Node
then
Print
(First_Declarative_Item_Of (Node, In_Tree),
begin
while Present (String_Node) loop
Output_String
- (String_Value_Of (String_Node, In_Tree),
- Indent);
+ (String_Value_Of (String_Node, In_Tree), Indent);
String_Node :=
Next_Literal_String (String_Node, In_Tree);
if Source_Index_Of (Node, In_Tree) /= 0 then
Write_String (" at", Indent);
Write_String
- (Source_Index_Of (Node, In_Tree)'Img,
- Indent);
+ (Source_Index_Of (Node, In_Tree)'Img, Indent);
end if;
when N_Attribute_Declaration =>
if Associative_Array_Index_Of (Node, In_Tree) /= No_Name then
Write_String (" (", Indent);
Output_String
- (Associative_Array_Index_Of (Node, In_Tree),
- Indent);
+ (Associative_Array_Index_Of (Node, In_Tree), Indent);
if Source_Index_Of (Node, In_Tree) /= 0 then
Write_String (" at", Indent);
Write_String
- (Source_Index_Of (Node, In_Tree)'Img,
- Indent);
+ (Source_Index_Of (Node, In_Tree)'Img, Indent);
end if;
Write_String (")", Indent);
else
-- Full associative array declaration
- if
- Present (Associative_Project_Of (Node, In_Tree))
- then
+ if Present (Associative_Project_Of (Node, In_Tree)) then
Output_Name
(Name_Of
(Associative_Project_Of (Node, In_Tree),
In_Tree),
Indent);
- if
- Present (Associative_Package_Of (Node, In_Tree))
+ if Present (Associative_Package_Of (Node, In_Tree))
then
Write_String (".", Indent);
Output_Name
Indent);
end if;
- elsif
- Present (Associative_Package_Of (Node, In_Tree))
+ elsif Present (Associative_Package_Of (Node, In_Tree))
then
Output_Name
(Name_Of
declare
Expression : Project_Node_Id :=
- First_Expression_In_List (Node, In_Tree);
+ First_Expression_In_List (Node, In_Tree);
begin
while Present (Expression) loop
declare
Index : constant Name_Id :=
Associative_Array_Index_Of (Node, In_Tree);
-
begin
if Index /= No_Name then
Write_String (" (", Indent);
while Present (Case_Item) loop
if Present
(First_Declarative_Item_Of (Case_Item, In_Tree))
- or else not Eliminate_Empty_Case_Constructions
+ or else not Eliminate_Empty_Case_Constructions
then
Is_Non_Empty := True;
exit;
Start_Line (Indent);
Write_String ("case ", Indent);
Print
- (Case_Variable_Reference_Of (Node, In_Tree),
- Indent);
+ (Case_Variable_Reference_Of (Node, In_Tree), Indent);
Write_String (" is", Indent);
Write_End_Of_Line_Comment (Node);
Print
declare
Label : Project_Node_Id :=
First_Choice_Of (Node, In_Tree);
+
begin
while Present (Label) loop
Print (Label, Indent);
procedure wpr
(Project : Prj.Tree.Project_Node_Id;
- In_Tree : Prj.Tree.Project_Node_Tree_Ref) is
+ In_Tree : Prj.Tree.Project_Node_Tree_Ref)
+ is
begin
Pretty_Print (Project, In_Tree, Backward_Compatibility => False);
end wpr;
projects / gcc.git / commitdiff