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>
* osint.adb: Minor reformatting
......
gcc/ada/makeutl.adb
......@@ -167,12 +167,13 @@ package body Makeutl is
Index_Separator : Character) return File_Name_Type
is
Result : File_Name_Type;
begin
Name_Len := 0;
Add_Str_To_Name_Buffer (Base_Name (Main));
-- Remove the extension, if any, that is the last part of the base
-- name starting with a dot and following some characters.
-- Remove the extension, if any, that is the last part of the base name
-- starting with a dot and following some characters.
for J in reverse 2 .. Name_Len loop
if Name_Buffer (J) = '.' then
......@@ -192,6 +193,7 @@ package body Makeutl is
Add_Str_To_Name_Buffer (Img (2 .. Img'Last));
end;
end if;
Result := Name_Find;
return Result;
end Base_Name_Index_For;
......
gcc/ada/makeutl.ads
......@@ -66,8 +66,8 @@ package Makeutl is
(Main : String;
Main_Index : Int;
Index_Separator : Character) return File_Name_Type;
-- Returns the base name of Main, without the extension, plus the
-- Index_Separator followed by the Main_Index, if Main_Index is not 0.
-- Returns the base name of Main, without the extension, followed by the
-- Index_Separator followed by the Main_Index if it is non-zero.
function Executable_Prefix_Path return String;
-- Return the absolute path parent directory of the directory where the
......@@ -87,9 +87,9 @@ package Makeutl is
-- one of its source. Returns False otherwise.
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
-- if everything is still valid
-- if everything is still valid.
function Is_External_Assignment
(Tree : Prj.Tree.Project_Node_Tree_Ref;
......@@ -121,11 +121,11 @@ package Makeutl is
S2 : String := "";
Prefix : String := " -> ";
Minimum_Verbosity : Opt.Verbosity_Level_Type := Opt.Low);
-- If the verbose flag (Verbose_Mode) is set and the verbosity level is
-- at least equal to Minimum_Verbosity, then print Prefix to standard
-- output followed by N1 and S1. If N2 /= No_Name then N2 is printed after
-- S1. S2 is printed last. Both N1 and N2 are printed in quotation marks.
-- The two forms differ only in taking Name_Id or File_name_Type arguments.
-- If the verbose flag (Verbose_Mode) is set and the verbosity level is at
-- least equal to Minimum_Verbosity, then print Prefix to standard output
-- followed by N1 and S1. If N2 /= No_Name then N2 is printed after S1. S2
-- is printed last. Both N1 and N2 are printed in quotation marks. The two
-- forms differ only in taking Name_Id or File_name_Type arguments.
function Linker_Options_Switches
(Project : Project_Id;
......@@ -142,10 +142,30 @@ package Makeutl is
-- Find the index of a unit in a source file. Return zero if the file is
-- 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
-- from the table.
function Path_Or_File_Name (Path : Path_Name_Type) return String;
-- 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);
-- Add one main to the table
......@@ -180,22 +200,6 @@ package Makeutl is
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 --
----------------------
......
gcc/ada/prj-proc.adb
......@@ -1869,12 +1869,16 @@ package body Prj.Proc is
else
declare
Index_Name : Name_Id :=
Associative_Array_Index_Of
(Current_Item, From_Project_Node_Tree);
Associative_Array_Index_Of
(Current_Item,
From_Project_Node_Tree);
Source_Index : constant Int :=
Source_Index_Of
(Current_Item, From_Project_Node_Tree);
The_Array : Array_Id;
Source_Index_Of
(Current_Item,
From_Project_Node_Tree);
The_Array : Array_Id;
The_Array_Element : Array_Element_Id :=
No_Array_Element;
......@@ -1892,9 +1896,9 @@ package body Prj.Proc is
if Pkg /= No_Package then
The_Array :=
In_Tree.Packages.Table (Pkg).Decl.Arrays;
else
The_Array := Project.Decl.Arrays;
The_Array :=
Project.Decl.Arrays;
end if;
while
......@@ -1903,8 +1907,8 @@ package body Prj.Proc is
In_Tree.Arrays.Table (The_Array).Name /=
Current_Item_Name
loop
The_Array := In_Tree.Arrays.Table
(The_Array).Next;
The_Array :=
In_Tree.Arrays.Table (The_Array).Next;
end loop;
-- If the array cannot be found, create a new entry
......@@ -1952,7 +1956,7 @@ package body Prj.Proc is
and then
(In_Tree.Array_Elements.Table
(The_Array_Element).Index /= Index_Name
or else
or else
In_Tree.Array_Elements.Table
(The_Array_Element).Src_Index /= Source_Index)
loop
......@@ -1968,21 +1972,23 @@ package body Prj.Proc is
if The_Array_Element = No_Array_Element then
Array_Element_Table.Increment_Last
(In_Tree.Array_Elements);
The_Array_Element := Array_Element_Table.Last
(In_Tree.Array_Elements);
The_Array_Element :=
Array_Element_Table.Last
(In_Tree.Array_Elements);
In_Tree.Array_Elements.Table
(The_Array_Element) :=
(Index => Index_Name,
Src_Index => Source_Index,
(Index => Index_Name,
Src_Index => Source_Index,
Index_Case_Sensitive =>
not Case_Insensitive
(Current_Item, From_Project_Node_Tree),
Value => New_Value,
Next => In_Tree.Arrays.Table
(The_Array).Value);
In_Tree.Arrays.Table
(The_Array).Value := The_Array_Element;
Value => New_Value,
Next =>
In_Tree.Arrays.Table (The_Array).Value);
In_Tree.Arrays.Table (The_Array).Value :=
The_Array_Element;
-- An element with the same index already exists,
-- just replace its value with the new one.
......
gcc/ada/prj.adb
......@@ -687,10 +687,11 @@ package body Prj is
is
Index_Img : constant String := Source_Index'Img;
Last : Natural;
begin
Get_Name_String (Source_File_Name);
Last := Name_Len;
Last := Name_Len;
while Last > 1 and then Name_Buffer (Last) /= '.' loop
Last := Last - 1;
end loop;
......@@ -704,7 +705,6 @@ package body Prj is
if Object_File_Suffix = No_Name then
Add_Str_To_Name_Buffer (Object_Suffix);
else
Add_Str_To_Name_Buffer (Get_Name_String (Object_File_Suffix));
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