From: Arnaud Charlet Date: Tue, 29 Jul 2014 15:06:34 +0000 (+0200) Subject: [multiple changes] X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=38564f81946e0a79b7a3da3459eb4e40442d0ee6;p=gcc.git [multiple changes] 2014-07-29 Robert Dewar * sem_ch3.adb, prj.adb: Minor reformatting. 2014-07-29 Vincent Celier * 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 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index eb218d687a3..6108f5b00c1 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,15 @@ +2014-07-29 Robert Dewar + + * sem_ch3.adb, prj.adb: Minor reformatting. + +2014-07-29 Vincent Celier + + * 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 * gnat_ugn.texi: Document that configuration pragmas files are diff --git a/gcc/ada/prj-pp.adb b/gcc/ada/prj-pp.adb index 15e3dcf651e..7c21e101939 100644 --- a/gcc/ada/prj-pp.adb +++ b/gcc/ada/prj-pp.adb @@ -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; diff --git a/gcc/ada/prj.adb b/gcc/ada/prj.adb index becab3eb8c5..e4c7784297b 100644 --- a/gcc/ada/prj.adb +++ b/gcc/ada/prj.adb @@ -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); diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index b94a1f2f1f0..ad59f58c8e1 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -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;