OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes] 

2014-07-29  Robert Dewar  <dewar@adacore.com>

	* sem_ch3.adb, prj.adb: Minor reformatting.

2014-07-29  Vincent Celier  <celier@adacore.com>

	* prj-pp.adb (Pretty_Print.Output_Project_File): New
	procedure to output project file names between quotes without
	concatenation, even if the line is too long.
	(Pretty_Print): Use Output_Project_File for project being extended and
	project imported.

From-SVN: r213210
This commit is contained in:
Arnaud Charlet 2014-07-29 17:06:34 +02:00
parent 5f6fb720bb
commit 38564f8194
4 changed files with 72 additions and 52 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
gcc/ada/ChangeLog
View File

@ -1,3 +1,15 @@
2014-07-29 Robert Dewar <dewar@adacore.com>
* sem_ch3.adb, prj.adb: Minor reformatting.
2014-07-29 Vincent Celier <celier@adacore.com>
* prj-pp.adb (Pretty_Print.Output_Project_File): New
procedure to output project file names between quotes without
concatenation, even if the line is too long.
(Pretty_Print): Use Output_Project_File for project being extended and
project imported.
2014-07-29 Vincent Celier <celier@adacore.com> 2014-07-29 Vincent Celier <celier@adacore.com>
* gnat_ugn.texi: Document that configuration pragmas files are * gnat_ugn.texi: Document that configuration pragmas files are

110
gcc/ada/prj-pp.adb
View File

@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
@ -35,8 +35,8 @@ package body Prj.PP is
Not_Tested : array (Project_Node_Kind) of Boolean := (others => True); Not_Tested : array (Project_Node_Kind) of Boolean := (others => True);
procedure Indicate_Tested (Kind : Project_Node_Kind); procedure Indicate_Tested (Kind : Project_Node_Kind);
-- Set the corresponding component of array Not_Tested to False. -- Set the corresponding component of array Not_Tested to False. Only
-- Only called by pragmas Debug. -- called by Debug pragmas.
--------------------- ---------------------
-- Indicate_Tested -- -- Indicate_Tested --
@ -84,14 +84,16 @@ package body Prj.PP is
procedure Start_Line (Indent : Natural); procedure Start_Line (Indent : Natural);
-- Outputs the indentation at the beginning of the line -- 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 : Name_Id; Indent : Natural);
procedure Output_String (S : Path_Name_Type; Indent : Natural);
-- Outputs a string using the default output procedures -- Outputs a string using the default output procedures
procedure Write_Empty_Line (Always : Boolean := False); procedure Write_Empty_Line (Always : Boolean := False);
-- Outputs an empty line, only if the previous line was not empty -- Outputs an empty line, only if the previous line was not empty
-- already and either Always is True or Minimize_Empty_Lines is -- already and either Always is True or Minimize_Empty_Lines is False.
-- False.
procedure Write_Line (S : String); procedure Write_Line (S : String);
-- Outputs S followed by a new line -- Outputs S followed by a new line
@ -100,12 +102,12 @@ package body Prj.PP is
(S : String; (S : String;
Indent : Natural; Indent : Natural;
Truncated : Boolean := False); Truncated : Boolean := False);
-- Outputs S using Write_Str, starting a new line if line would -- Outputs S using Write_Str, starting a new line if line would become
-- become too long, when Truncated = False. -- too long, when Truncated = False. When Truncated = True, only the
-- When Truncated = True, only the part of the string that can fit on -- part of the string that can fit on the line is output.
-- the line is output.
procedure Write_End_Of_Line_Comment (Node : Project_Node_Id); procedure Write_End_Of_Line_Comment (Node : Project_Node_Id);
-- Needs comment???
Write_Char : Write_Char_Ap := Output.Write_Char'Access; Write_Char : Write_Char_Ap := Output.Write_Char'Access;
Write_Eol : Write_Eol_Ap := Output.Write_Eol'Access; Write_Eol : Write_Eol_Ap := Output.Write_Eol'Access;
@ -199,6 +201,28 @@ package body Prj.PP is
Column := Column + Name_Len; Column := Column + Name_Len;
end Output_Name; 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 -- -- Output_String --
------------------- -------------------
@ -256,11 +280,6 @@ package body Prj.PP is
Column := Column + 1; Column := Column + 1;
end Output_String; 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 -- -- Start_Line --
---------------- ----------------
@ -323,15 +342,16 @@ package body Prj.PP is
procedure Write_String procedure Write_String
(S : String; (S : String;
Indent : Natural; Indent : Natural;
Truncated : Boolean := False) is Truncated : Boolean := False)
is
Length : Natural := S'Length; Length : Natural := S'Length;
begin begin
if Column = 0 and then Indent /= 0 then if Column = 0 and then Indent /= 0 then
Start_Line (Indent + Increment); Start_Line (Indent + Increment);
end if; end if;
-- If the string would not fit on the line, -- If the string would not fit on the line, start a new line
-- start a new line.
if Column + Length > Max_Line_Length then if Column + Length > Max_Line_Length then
if Truncated then if Truncated then
@ -358,9 +378,7 @@ package body Prj.PP is
procedure Print (Node : Project_Node_Id; Indent : Natural) is procedure Print (Node : Project_Node_Id; Indent : Natural) is
begin begin
if Present (Node) then if Present (Node) then
case Kind_Of (Node, In_Tree) is case Kind_Of (Node, In_Tree) is
when N_Project => when N_Project =>
pragma Debug (Indicate_Tested (N_Project)); pragma Debug (Indicate_Tested (N_Project));
if Present (First_With_Clause_Of (Node, In_Tree)) then if Present (First_With_Clause_Of (Node, In_Tree)) then
@ -407,9 +425,8 @@ package body Prj.PP is
Write_String ("all ", Indent); Write_String ("all ", Indent);
end if; end if;
Output_String Output_Project_File
(Extended_Project_Path_Of (Node, In_Tree), (Name_Id (Extended_Project_Path_Of (Node, In_Tree)));
Indent);
end if; end if;
Write_String (" is", Indent); Write_String (" is", Indent);
@ -440,9 +457,8 @@ package body Prj.PP is
pragma Debug (Indicate_Tested (N_With_Clause)); pragma Debug (Indicate_Tested (N_With_Clause));
-- The with clause will sometimes contain an invalid name -- The with clause will sometimes contain an invalid name
-- when we are importing a virtual project from an -- when we are importing a virtual project from an extending
-- extending all project. Do not output anything in this -- all project. Do not output anything in this case.
-- case
if Name_Of (Node, In_Tree) /= No_Name if Name_Of (Node, In_Tree) /= No_Name
and then String_Value_Of (Node, In_Tree) /= No_Name and then String_Value_Of (Node, In_Tree) /= No_Name
@ -460,7 +476,10 @@ package body Prj.PP is
Write_String ("with ", Indent); Write_String ("with ", Indent);
end if; 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 if Is_Not_Last_In_List (Node, In_Tree) then
Write_String (", ", Indent); Write_String (", ", Indent);
@ -522,8 +541,7 @@ package body Prj.PP is
Print (First_Comment_After (Node, In_Tree), Print (First_Comment_After (Node, In_Tree),
Indent + Increment); Indent + Increment);
if First_Declarative_Item_Of (Node, In_Tree) /= if First_Declarative_Item_Of (Node, In_Tree) /= Empty_Node
Empty_Node
then then
Print Print
(First_Declarative_Item_Of (Node, In_Tree), (First_Declarative_Item_Of (Node, In_Tree),
@ -557,8 +575,7 @@ package body Prj.PP is
begin begin
while Present (String_Node) loop while Present (String_Node) loop
Output_String Output_String
(String_Value_Of (String_Node, In_Tree), (String_Value_Of (String_Node, In_Tree), Indent);
Indent);
String_Node := String_Node :=
Next_Literal_String (String_Node, In_Tree); Next_Literal_String (String_Node, In_Tree);
@ -579,8 +596,7 @@ package body Prj.PP is
if Source_Index_Of (Node, In_Tree) /= 0 then if Source_Index_Of (Node, In_Tree) /= 0 then
Write_String (" at", Indent); Write_String (" at", Indent);
Write_String Write_String
(Source_Index_Of (Node, In_Tree)'Img, (Source_Index_Of (Node, In_Tree)'Img, Indent);
Indent);
end if; end if;
when N_Attribute_Declaration => when N_Attribute_Declaration =>
@ -593,14 +609,12 @@ package body Prj.PP is
if Associative_Array_Index_Of (Node, In_Tree) /= No_Name then if Associative_Array_Index_Of (Node, In_Tree) /= No_Name then
Write_String (" (", Indent); Write_String (" (", Indent);
Output_String Output_String
(Associative_Array_Index_Of (Node, In_Tree), (Associative_Array_Index_Of (Node, In_Tree), Indent);
Indent);
if Source_Index_Of (Node, In_Tree) /= 0 then if Source_Index_Of (Node, In_Tree) /= 0 then
Write_String (" at", Indent); Write_String (" at", Indent);
Write_String Write_String
(Source_Index_Of (Node, In_Tree)'Img, (Source_Index_Of (Node, In_Tree)'Img, Indent);
Indent);
end if; end if;
Write_String (")", Indent); Write_String (")", Indent);
@ -614,17 +628,14 @@ package body Prj.PP is
else else
-- Full associative array declaration -- Full associative array declaration
if if Present (Associative_Project_Of (Node, In_Tree)) then
Present (Associative_Project_Of (Node, In_Tree))
then
Output_Name Output_Name
(Name_Of (Name_Of
(Associative_Project_Of (Node, In_Tree), (Associative_Project_Of (Node, In_Tree),
In_Tree), In_Tree),
Indent); Indent);
if if Present (Associative_Package_Of (Node, In_Tree))
Present (Associative_Package_Of (Node, In_Tree))
then then
Write_String (".", Indent); Write_String (".", Indent);
Output_Name Output_Name
@ -634,8 +645,7 @@ package body Prj.PP is
Indent); Indent);
end if; end if;
elsif elsif Present (Associative_Package_Of (Node, In_Tree))
Present (Associative_Package_Of (Node, In_Tree))
then then
Output_Name Output_Name
(Name_Of (Name_Of
@ -705,7 +715,7 @@ package body Prj.PP is
declare declare
Expression : Project_Node_Id := Expression : Project_Node_Id :=
First_Expression_In_List (Node, In_Tree); First_Expression_In_List (Node, In_Tree);
begin begin
while Present (Expression) loop while Present (Expression) loop
@ -783,7 +793,6 @@ package body Prj.PP is
declare declare
Index : constant Name_Id := Index : constant Name_Id :=
Associative_Array_Index_Of (Node, In_Tree); Associative_Array_Index_Of (Node, In_Tree);
begin begin
if Index /= No_Name then if Index /= No_Name then
Write_String (" (", Indent); Write_String (" (", Indent);
@ -804,7 +813,7 @@ package body Prj.PP is
while Present (Case_Item) loop while Present (Case_Item) loop
if Present if Present
(First_Declarative_Item_Of (Case_Item, In_Tree)) (First_Declarative_Item_Of (Case_Item, In_Tree))
or else not Eliminate_Empty_Case_Constructions or else not Eliminate_Empty_Case_Constructions
then then
Is_Non_Empty := True; Is_Non_Empty := True;
exit; exit;
@ -819,8 +828,7 @@ package body Prj.PP is
Start_Line (Indent); Start_Line (Indent);
Write_String ("case ", Indent); Write_String ("case ", Indent);
Print Print
(Case_Variable_Reference_Of (Node, In_Tree), (Case_Variable_Reference_Of (Node, In_Tree), Indent);
Indent);
Write_String (" is", Indent); Write_String (" is", Indent);
Write_End_Of_Line_Comment (Node); Write_End_Of_Line_Comment (Node);
Print Print
@ -867,6 +875,7 @@ package body Prj.PP is
declare declare
Label : Project_Node_Id := Label : Project_Node_Id :=
First_Choice_Of (Node, In_Tree); First_Choice_Of (Node, In_Tree);
begin begin
while Present (Label) loop while Present (Label) loop
Print (Label, Indent); Print (Label, Indent);
@ -975,7 +984,8 @@ package body Prj.PP is
procedure wpr procedure wpr
(Project : Prj.Tree.Project_Node_Id; (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 begin
Pretty_Print (Project, In_Tree, Backward_Compatibility => False); Pretty_Print (Project, In_Tree, Backward_Compatibility => False);
end wpr; end wpr;

1
gcc/ada/prj.adb
View File

@ -142,7 +142,6 @@ package body Prj is
declare declare
New_Buffer : constant String_Access := New_Buffer : constant String_Access :=
new String (1 .. 2 * To'Length); new String (1 .. 2 * To'Length);
begin begin
New_Buffer (1 .. Last) := To (1 .. Last); New_Buffer (1 .. Last) := To (1 .. Last);
Free (To); Free (To);

1
gcc/ada/sem_ch3.adb
View File

@ -3504,7 +3504,6 @@ package body Sem_Ch3 is
and then Nkind (E) = N_Aggregate and then Nkind (E) = N_Aggregate
then then
Set_Etype (E, T); Set_Etype (E, T);
else else
Resolve (E, T); Resolve (E, T);
end if; end if;