Skip to content

R
riscv-gcc-1
Commit c8c41617 by Robert Dewar Committed by Arnaud Charlet
Options

makeutl.adb, [...]: Minor reformatting. 

2009-11-30  Robert Dewar  <dewar@adacore.com>

	* makeutl.adb, makeutl.ads, prj-proc.adb, prj.adb, prj.ads: Minor
	reformatting.

From-SVN: r154783
parent c9df623a
Showing with 68 additions and 51 deletions
gcc/ada/ChangeLog
2009-11-30 Robert Dewar <dewar@adacore.com>
* makeutl.adb, makeutl.ads, prj-proc.adb, prj.adb, prj.ads: Minor
reformatting.
2009-11-30 Thomas Quinot <quinot@adacore.com> 2009-11-30 Thomas Quinot <quinot@adacore.com>
* osint.adb: Minor reformatting * osint.adb: Minor reformatting
......
gcc/ada/makeutl.adb
...@@ -167,12 +167,13 @@ package body Makeutl is ...@@ -167,12 +167,13 @@ package body Makeutl is
Index_Separator : Character) return File_Name_Type Index_Separator : Character) return File_Name_Type
is is
Result : File_Name_Type; Result : File_Name_Type;
begin begin
Name_Len := 0; Name_Len := 0;
Add_Str_To_Name_Buffer (Base_Name (Main)); Add_Str_To_Name_Buffer (Base_Name (Main));
-- Remove the extension, if any, that is the last part of the base -- Remove the extension, if any, that is the last part of the base name
-- name starting with a dot and following some characters. -- starting with a dot and following some characters.
for J in reverse 2 .. Name_Len loop for J in reverse 2 .. Name_Len loop
if Name_Buffer (J) = '.' then if Name_Buffer (J) = '.' then
...@@ -192,6 +193,7 @@ package body Makeutl is ...@@ -192,6 +193,7 @@ package body Makeutl is
Add_Str_To_Name_Buffer (Img (2 .. Img'Last)); Add_Str_To_Name_Buffer (Img (2 .. Img'Last));
end; end;
end if; end if;
Result := Name_Find; Result := Name_Find;
return Result; return Result;
end Base_Name_Index_For; end Base_Name_Index_For;
......
gcc/ada/makeutl.ads
...@@ -66,8 +66,8 @@ package Makeutl is ...@@ -66,8 +66,8 @@ package Makeutl is
(Main : String; (Main : String;
Main_Index : Int; Main_Index : Int;
Index_Separator : Character) return File_Name_Type; Index_Separator : Character) return File_Name_Type;
-- Returns the base name of Main, without the extension, plus the -- Returns the base name of Main, without the extension, followed by the
-- Index_Separator followed by the Main_Index, if Main_Index is not 0. -- Index_Separator followed by the Main_Index if it is non-zero.
function Executable_Prefix_Path return String; function Executable_Prefix_Path return String;
-- Return the absolute path parent directory of the directory where the -- Return the absolute path parent directory of the directory where the
...@@ -87,9 +87,9 @@ package Makeutl is ...@@ -87,9 +87,9 @@ package Makeutl is
-- one of its source. Returns False otherwise. -- one of its source. Returns False otherwise.
function Check_Source_Info_In_ALI (The_ALI : ALI.ALI_Id) return Boolean; function Check_Source_Info_In_ALI (The_ALI : ALI.ALI_Id) return Boolean;
-- Check whether all file references in ALI are still valid (ie the -- Check whether all file references in ALI are still valid (i.e. the
-- source files are still associated with the same units). Return True -- source files are still associated with the same units). Return True
-- if everything is still valid -- if everything is still valid.
function Is_External_Assignment function Is_External_Assignment
(Tree : Prj.Tree.Project_Node_Tree_Ref; (Tree : Prj.Tree.Project_Node_Tree_Ref;
...@@ -121,11 +121,11 @@ package Makeutl is ...@@ -121,11 +121,11 @@ package Makeutl is
S2 : String := ""; S2 : String := "";
Prefix : String := " -> "; Prefix : String := " -> ";
Minimum_Verbosity : Opt.Verbosity_Level_Type := Opt.Low); Minimum_Verbosity : Opt.Verbosity_Level_Type := Opt.Low);
-- If the verbose flag (Verbose_Mode) is set and the verbosity level is -- If the verbose flag (Verbose_Mode) is set and the verbosity level is at
-- at least equal to Minimum_Verbosity, then print Prefix to standard -- least equal to Minimum_Verbosity, then print Prefix to standard output
-- output followed by N1 and S1. If N2 /= No_Name then N2 is printed after -- followed by N1 and S1. If N2 /= No_Name then N2 is printed after S1. S2
-- S1. S2 is printed last. Both N1 and N2 are printed in quotation marks. -- is printed last. Both N1 and N2 are printed in quotation marks. The two
-- The two forms differ only in taking Name_Id or File_name_Type arguments. -- forms differ only in taking Name_Id or File_name_Type arguments.
function Linker_Options_Switches function Linker_Options_Switches
(Project : Project_Id; (Project : Project_Id;
...@@ -142,10 +142,30 @@ package Makeutl is ...@@ -142,10 +142,30 @@ package Makeutl is
-- Find the index of a unit in a source file. Return zero if the file is -- Find the index of a unit in a source file. Return zero if the file is
-- not a multi-unit source file. -- not a multi-unit source file.
package Mains is procedure Test_If_Relative_Path
(Switch : in out String_Access;
Parent : String;
Including_L_Switch : Boolean := True;
Including_Non_Switch : Boolean := True;
Including_RTS : Boolean := False);
-- Test if Switch is a relative search path switch. If it is, fail if
-- Parent is the empty string, otherwise prepend the path with Parent.
-- This subprogram is only called when using project files. For gnatbind
-- switches, Including_L_Switch is False, because the argument of the -L
-- switch is not a path. If Including_RTS is True, process also switches
-- --RTS=.
-- Mains are stored in a table. An index is used to retrieve the mains function Path_Or_File_Name (Path : Path_Name_Type) return String;
-- from the table. -- Returns a file name if -df is used, otherwise return a path name
-----------
-- Mains --
-----------
-- Mains are stored in a table. An index is used to retrieve the mains
-- from the table.
package Mains is
procedure Add_Main (Name : String); procedure Add_Main (Name : String);
-- Add one main to the table -- Add one main to the table
...@@ -180,22 +200,6 @@ package Makeutl is ...@@ -180,22 +200,6 @@ package Makeutl is
end Mains; end Mains;
procedure Test_If_Relative_Path
(Switch : in out String_Access;
Parent : String;
Including_L_Switch : Boolean := True;
Including_Non_Switch : Boolean := True;
Including_RTS : Boolean := False);
-- Test if Switch is a relative search path switch. If it is, fail if
-- Parent is the empty string, otherwise prepend the path with Parent.
-- This subprogram is only called when using project files. For gnatbind
-- switches, Including_L_Switch is False, because the argument of the -L
-- switch is not a path. If Including_RTS is True, process also switches
-- --RTS=.
function Path_Or_File_Name (Path : Path_Name_Type) return String;
-- Returns a file name if -df is used, otherwise return a path name
---------------------- ----------------------
-- Marking Routines -- -- Marking Routines --
---------------------- ----------------------
......
gcc/ada/prj-proc.adb
...@@ -1869,12 +1869,16 @@ package body Prj.Proc is ...@@ -1869,12 +1869,16 @@ package body Prj.Proc is
else else
declare declare
Index_Name : Name_Id := Index_Name : Name_Id :=
Associative_Array_Index_Of Associative_Array_Index_Of
(Current_Item, From_Project_Node_Tree); (Current_Item,
From_Project_Node_Tree);
Source_Index : constant Int := Source_Index : constant Int :=
Source_Index_Of Source_Index_Of
(Current_Item, From_Project_Node_Tree); (Current_Item,
The_Array : Array_Id; From_Project_Node_Tree);
The_Array : Array_Id;
The_Array_Element : Array_Element_Id := The_Array_Element : Array_Element_Id :=
No_Array_Element; No_Array_Element;
...@@ -1892,9 +1896,9 @@ package body Prj.Proc is ...@@ -1892,9 +1896,9 @@ package body Prj.Proc is
if Pkg /= No_Package then if Pkg /= No_Package then
The_Array := The_Array :=
In_Tree.Packages.Table (Pkg).Decl.Arrays; In_Tree.Packages.Table (Pkg).Decl.Arrays;
else else
The_Array := Project.Decl.Arrays; The_Array :=
Project.Decl.Arrays;
end if; end if;
while while
...@@ -1903,8 +1907,8 @@ package body Prj.Proc is ...@@ -1903,8 +1907,8 @@ package body Prj.Proc is
In_Tree.Arrays.Table (The_Array).Name /= In_Tree.Arrays.Table (The_Array).Name /=
Current_Item_Name Current_Item_Name
loop loop
The_Array := In_Tree.Arrays.Table The_Array :=
(The_Array).Next; In_Tree.Arrays.Table (The_Array).Next;
end loop; end loop;
-- If the array cannot be found, create a new entry -- If the array cannot be found, create a new entry
...@@ -1952,7 +1956,7 @@ package body Prj.Proc is ...@@ -1952,7 +1956,7 @@ package body Prj.Proc is
and then and then
(In_Tree.Array_Elements.Table (In_Tree.Array_Elements.Table
(The_Array_Element).Index /= Index_Name (The_Array_Element).Index /= Index_Name
or else or else
In_Tree.Array_Elements.Table In_Tree.Array_Elements.Table
(The_Array_Element).Src_Index /= Source_Index) (The_Array_Element).Src_Index /= Source_Index)
loop loop
...@@ -1968,21 +1972,23 @@ package body Prj.Proc is ...@@ -1968,21 +1972,23 @@ package body Prj.Proc is
if The_Array_Element = No_Array_Element then if The_Array_Element = No_Array_Element then
Array_Element_Table.Increment_Last Array_Element_Table.Increment_Last
(In_Tree.Array_Elements); (In_Tree.Array_Elements);
The_Array_Element := Array_Element_Table.Last The_Array_Element :=
(In_Tree.Array_Elements); Array_Element_Table.Last
(In_Tree.Array_Elements);
In_Tree.Array_Elements.Table In_Tree.Array_Elements.Table
(The_Array_Element) := (The_Array_Element) :=
(Index => Index_Name, (Index => Index_Name,
Src_Index => Source_Index, Src_Index => Source_Index,
Index_Case_Sensitive => Index_Case_Sensitive =>
not Case_Insensitive not Case_Insensitive
(Current_Item, From_Project_Node_Tree), (Current_Item, From_Project_Node_Tree),
Value => New_Value, Value => New_Value,
Next => In_Tree.Arrays.Table Next =>
(The_Array).Value); In_Tree.Arrays.Table (The_Array).Value);
In_Tree.Arrays.Table
(The_Array).Value := The_Array_Element; In_Tree.Arrays.Table (The_Array).Value :=
The_Array_Element;
-- An element with the same index already exists, -- An element with the same index already exists,
-- just replace its value with the new one. -- just replace its value with the new one.
......
gcc/ada/prj.adb
...@@ -687,10 +687,11 @@ package body Prj is ...@@ -687,10 +687,11 @@ package body Prj is
is is
Index_Img : constant String := Source_Index'Img; Index_Img : constant String := Source_Index'Img;
Last : Natural; Last : Natural;
begin begin
Get_Name_String (Source_File_Name); Get_Name_String (Source_File_Name);
Last := Name_Len;
Last := Name_Len;
while Last > 1 and then Name_Buffer (Last) /= '.' loop while Last > 1 and then Name_Buffer (Last) /= '.' loop
Last := Last - 1; Last := Last - 1;
end loop; end loop;
...@@ -704,7 +705,6 @@ package body Prj is ...@@ -704,7 +705,6 @@ package body Prj is
if Object_File_Suffix = No_Name then if Object_File_Suffix = No_Name then
Add_Str_To_Name_Buffer (Object_Suffix); Add_Str_To_Name_Buffer (Object_Suffix);
else else
Add_Str_To_Name_Buffer (Get_Name_String (Object_File_Suffix)); Add_Str_To_Name_Buffer (Get_Name_String (Object_File_Suffix));
end if; end if;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment