Commit 1e887886 by Vincent Celier Committed by Arnaud Charlet

2008-05-27 Vincent Celier <celier@adacore.com>

	* makeutl.ads, makeutl.adb:
	(Set_Location): New procedure
	(Get_Location): New function
	(Update_Main): New procedure

From-SVN: r135993
parent fceeaab6
...@@ -481,8 +481,13 @@ package body Makeutl is ...@@ -481,8 +481,13 @@ package body Makeutl is
package body Mains is package body Mains is
type File_And_Loc is record
File_Name : File_Name_Type;
Location : Source_Ptr := No_Location;
end record;
package Names is new Table.Table package Names is new Table.Table
(Table_Component_Type => File_Name_Type, (Table_Component_Type => File_And_Loc,
Table_Index_Type => Integer, Table_Index_Type => Integer,
Table_Low_Bound => 1, Table_Low_Bound => 1,
Table_Initial => 10, Table_Initial => 10,
...@@ -502,7 +507,7 @@ package body Makeutl is ...@@ -502,7 +507,7 @@ package body Makeutl is
Name_Len := 0; Name_Len := 0;
Add_Str_To_Name_Buffer (Name); Add_Str_To_Name_Buffer (Name);
Names.Increment_Last; Names.Increment_Last;
Names.Table (Names.Last) := Name_Find; Names.Table (Names.Last) := (Name_Find, No_Location);
end Add_Main; end Add_Main;
------------ ------------
...@@ -515,6 +520,20 @@ package body Makeutl is ...@@ -515,6 +520,20 @@ package body Makeutl is
Mains.Reset; Mains.Reset;
end Delete; end Delete;
------------------
-- Get_Location --
------------------
function Get_Location return Source_Ptr is
begin
if Current < Names.First or else Current > Names.Last then
return No_Location;
else
return Names.Table (Current).Location;
end if;
end Get_Location;
--------------- ---------------
-- Next_Main -- -- Next_Main --
--------------- ---------------
...@@ -526,7 +545,7 @@ package body Makeutl is ...@@ -526,7 +545,7 @@ package body Makeutl is
else else
Current := Current + 1; Current := Current + 1;
return Get_Name_String (Names.Table (Current)); return Get_Name_String (Names.Table (Current).File_Name);
end if; end if;
end Next_Main; end Next_Main;
...@@ -548,6 +567,29 @@ package body Makeutl is ...@@ -548,6 +567,29 @@ package body Makeutl is
Current := 0; Current := 0;
end Reset; end Reset;
------------------
-- Set_Location --
------------------
procedure Set_Location (Location : Source_Ptr) is
begin
if Names.Last > 0 then
Names.Table (Names.Last).Location := Location;
end if;
end Set_Location;
-----------------
-- Update_Main --
-----------------
procedure Update_Main (Name : String) is
begin
if Current >= Names.First and then Current <= Names.Last then
Name_Len := 0;
Add_Str_To_Name_Buffer (Name);
Names.Table (Current).File_Name := Name_Find;
end if;
end Update_Main;
end Mains; end Mains;
---------- ----------
......
...@@ -103,6 +103,10 @@ package Makeutl is ...@@ -103,6 +103,10 @@ package Makeutl is
procedure Add_Main (Name : String); procedure Add_Main (Name : String);
-- Add one main to the table -- Add one main to the table
procedure Set_Location (Location : Source_Ptr);
-- Set the location of the last main added. By default, the location is
-- No_Location.
procedure Delete; procedure Delete;
-- Empty the table -- Empty the table
...@@ -113,6 +117,12 @@ package Makeutl is ...@@ -113,6 +117,12 @@ package Makeutl is
-- Increase the index and return the next main. -- Increase the index and return the next main.
-- If table is exhausted, return an empty string. -- If table is exhausted, return an empty string.
function Get_Location return Source_Ptr;
-- Get the location of the current main
procedure Update_Main (Name : String);
-- Update the file name of the current main
function Number_Of_Mains return Natural; function Number_Of_Mains return Natural;
-- Returns the number of mains added with Add_Main since the last call -- Returns the number of mains added with Add_Main since the last call
-- to Delete. -- to Delete.
......
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