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

[multiple changes]

Browse Source 
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>
* 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 --
-- --
-- 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- --
@ -35,8 +35,8 @@ package body Prj.PP is
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 --
@ -84,14 +84,16 @@ package body Prj.PP is
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
@ -100,12 +102,12 @@ package body Prj.PP is
(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;
@ -199,6 +201,28 @@ package body Prj.PP is
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 --
-------------------
@ -256,11 +280,6 @@ package body Prj.PP is
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 --
----------------
@ -323,15 +342,16 @@ package body Prj.PP is
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
@ -358,9 +378,7 @@ package body Prj.PP is
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
@ -407,9 +425,8 @@ package body Prj.PP is
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);
@ -440,9 +457,8 @@ package body Prj.PP is
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
@ -460,7 +476,10 @@ package body Prj.PP is
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);
@ -522,8 +541,7 @@ package body Prj.PP is
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),
@ -557,8 +575,7 @@ package body Prj.PP is
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);
@ -579,8 +596,7 @@ package body Prj.PP is
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 =>
@ -593,14 +609,12 @@ package body Prj.PP is
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);
@ -614,17 +628,14 @@ package body Prj.PP is
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
@ -634,8 +645,7 @@ package body Prj.PP is
Indent);
end if;
elsif
Present (Associative_Package_Of (Node, In_Tree))
elsif Present (Associative_Package_Of (Node, In_Tree))
then
Output_Name
(Name_Of
@ -705,7 +715,7 @@ package body Prj.PP is
declare
Expression : Project_Node_Id :=
First_Expression_In_List (Node, In_Tree);
First_Expression_In_List (Node, In_Tree);
begin
while Present (Expression) loop
@ -783,7 +793,6 @@ package body Prj.PP is
declare
Index : constant Name_Id :=
Associative_Array_Index_Of (Node, In_Tree);
begin
if Index /= No_Name then
Write_String (" (", Indent);
@ -804,7 +813,7 @@ package body Prj.PP is
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;
@ -819,8 +828,7 @@ package body Prj.PP is
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
@ -867,6 +875,7 @@ package body Prj.PP is
declare
Label : Project_Node_Id :=
First_Choice_Of (Node, In_Tree);
begin
while Present (Label) loop
Print (Label, Indent);
@ -975,7 +984,8 @@ package body Prj.PP is
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;

1
gcc/ada/prj.adb
View File

@ -142,7 +142,6 @@ package body Prj is
declare
New_Buffer : constant String_Access :=
new String (1 .. 2 * To'Length);
begin
New_Buffer (1 .. Last) := To (1 .. Last);
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
then
Set_Etype (E, T);
else
Resolve (E, T);
end if;