mirrors/gcc
0
0
Fork 0
mirror of https://gcc.gnu.org/git/gcc.git synced 2025-01-07 11:33:45 +08:00
Code Issues Actions Packages Projects Releases Wiki Activity

make.adb, [...] (Project_Tree): Duplicates the global variable that also exists in makeutl.ads...

Browse Source 
2009-07-28  Emmanuel Briot  <briot@adacore.com>

	* make.adb, makeutl.adb, makeutl.ads (Project_Tree): Duplicates the
	global variable that also exists in makeutl.ads, and that some routines
	in that package use already.
	(Check): Moved part of the code to makeutl.adb for better sharing with
	gprbuild.

From-SVN: r150157
This commit is contained in:
Emmanuel Briot 2009-07-28 13:41:47 +00:00 committed by Arnaud Charlet
parent f563194df3
commit 3899022082
4 changed files with 108 additions and 68 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
gcc/ada/ChangeLog
View File

@ -1,3 +1,11 @@
2009-07-28 Emmanuel Briot <briot@adacore.com>
* make.adb, makeutl.adb, makeutl.ads (Project_Tree): Duplicates the
global variable that also exists in makeutl.ads, and that some routines
in that package use already.
(Check): Moved part of the code to makeutl.adb for better sharing with
gprbuild.
2009-07-28 Arnaud Charlet <charlet@adacore.com>
* gcc-interface/Make-lang.in: Update dependencies.

72
gcc/ada/make.adb
View File

@ -343,8 +343,6 @@ package body Make is
Current_Verbosity : Prj.Verbosity := Prj.Default;
-- Verbosity to parse the project files
Project_Tree : constant Project_Tree_Ref := new Project_Tree_Data;
Main_Project : Prj.Project_Id := No_Project;
-- The project id of the main project file, if any
@ -1804,72 +1802,10 @@ package body Make is
elsif not Read_Only and then Main_Project /= No_Project then
-- Check if a file name does not correspond to the mapping of
-- units to file names.
declare
SD : Sdep_Record;
WR : With_Record;
Unit_Name : Name_Id;
begin
U_Chk :
for U in ALIs.Table (ALI).First_Unit ..
ALIs.Table (ALI).Last_Unit
loop
-- Check if the file name is one of the source of the
-- unit.
Get_Name_String (Units.Table (U).Uname);
Name_Len := Name_Len - 2;
Unit_Name := Name_Find;
if File_Not_A_Source_Of
(Unit_Name, Units.Table (U).Sfile)
then
ALI := No_ALI_Id;
return;
end if;
-- Do the same check for each of the withed units
W_Check :
for W in Units.Table (U).First_With
..
Units.Table (U).Last_With
loop
WR := Withs.Table (W);
if WR.Sfile /= No_File then
Get_Name_String (WR.Uname);
Name_Len := Name_Len - 2;
Unit_Name := Name_Find;
if File_Not_A_Source_Of (Unit_Name, WR.Sfile) then
ALI := No_ALI_Id;
return;
end if;
end if;
end loop W_Check;
end loop U_Chk;
-- Check also the subunits
D_Check :
for D in ALIs.Table (ALI).First_Sdep ..
ALIs.Table (ALI).Last_Sdep
loop
SD := Sdep.Table (D);
Unit_Name := SD.Subunit_Name;
if Unit_Name /= No_Name then
if File_Not_A_Source_Of (Unit_Name, SD.Sfile) then
ALI := No_ALI_Id;
return;
end if;
end if;
end loop D_Check;
end;
if not Check_Source_Info_In_ALI (ALI) then
ALI := No_ALI_Id;
return;
end if;
-- Check that the ALI file is in the correct object directory.
-- If it is in the object directory of a project that is

90
gcc/ada/makeutl.adb
View File

@ -23,6 +23,7 @@
-- --
------------------------------------------------------------------------------
with ALI; use ALI;
with Debug;
with Osint; use Osint;
with Output; use Output;
@ -155,6 +156,95 @@ package body Makeutl is
end if;
end Add_Linker_Option;
------------------------------
-- Check_Source_Info_In_ALI --
------------------------------
function Check_Source_Info_In_ALI (The_ALI : ALI_Id) return Boolean is
Unit_Name : Name_Id;
begin
U_Chk :
for U in ALIs.Table (The_ALI).First_Unit
.. ALIs.Table (The_ALI).Last_Unit
loop
-- Check if the file name is one of the source of the unit.
Get_Name_String (Units.Table (U).Uname);
Name_Len := Name_Len - 2;
Unit_Name := Name_Find;
if File_Not_A_Source_Of (Unit_Name, Units.Table (U).Sfile) then
return False;
end if;
-- Do the same check for each of the withed units
W_Check :
for W in Units.Table (U).First_With .. Units.Table (U).Last_With loop
declare
WR : ALI.With_Record renames Withs.Table (W);
begin
if WR.Sfile /= No_File then
Get_Name_String (WR.Uname);
Name_Len := Name_Len - 2;
Unit_Name := Name_Find;
if File_Not_A_Source_Of (Unit_Name, WR.Sfile) then
return False;
end if;
end if;
end;
end loop W_Check;
end loop U_Chk;
-- Check also the subunits
D_Check :
for D in ALIs.Table (The_ALI).First_Sdep
.. ALIs.Table (The_ALI).Last_Sdep
loop
declare
SD : Sdep_Record renames Sdep.Table (D);
begin
Unit_Name := SD.Subunit_Name;
if Unit_Name /= No_Name then
-- For separates, the file is no longer associated with the
-- unit ("proc-sep.adb" is not associated with unit "proc.sep".
-- So we need to check whether the source file still exists in
-- the source tree: it will if it matches the naming scheme
-- (and then will be for the same unit).
if Find_Source
(In_Tree => Project_Tree,
Project => No_Project,
Base_Name => SD.Sfile) = No_Source
then
-- If this is not a runtime file (when using -a) ? Otherwise
-- we get complaints about a-except.adb, which uses
-- separates.
if not Check_Readonly_Files
or else Find_File (SD.Sfile, Osint.Source) = No_File
then
if Verbose_Mode then
Write_Line
("While parsing ALI file: Sdep associates "
& Get_Name_String (SD.Sfile)
& " with unit " & Get_Name_String (Unit_Name)
& " but this does not match what was found while"
& " parsing the project. Will recompile");
end if;
return False;
end if;
end if;
end if;
end;
end loop D_Check;
return True;
end Check_Source_Info_In_ALI;
-----------------
-- Create_Name --
-----------------

6
gcc/ada/makeutl.ads
View File

@ -23,6 +23,7 @@
-- --
------------------------------------------------------------------------------
with ALI;
with Namet; use Namet;
with Opt;
with Osint;
@ -77,6 +78,11 @@ package Makeutl is
-- Returns True if the unit is in one of the project file, but the file
-- name is not 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 source
-- files are still associated with the same units).
-- Return True if everything is still valid
function Is_External_Assignment (Argv : String) return Boolean;
-- Verify that an external assignment switch is syntactically correct
--