Commit 71780989 by Vincent Celier Committed by Arnaud Charlet

osinte-c.ads, [...] (Set_Library_Info_Name): Fail if base name of specified…

osinte-c.ads, [...] (Set_Library_Info_Name): Fail if base name of specified object file is not equal to base name of source.

2007-04-20  Vincent Celier  <celier@adacore.com>

	* osinte-c.ads, osint-c.adb (Set_Library_Info_Name): Fail if base name
	of specified object file is not equal to base name of source.

From-SVN: r125436
parent b5755e2b
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2001-2006, Free Software Foundation, Inc. -- -- Copyright (C) 2001-2007, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -25,7 +25,6 @@ ...@@ -25,7 +25,6 @@
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
with Hostparm; with Hostparm;
with Namet; use Namet;
with Opt; use Opt; with Opt; use Opt;
with Tree_IO; use Tree_IO; with Tree_IO; use Tree_IO;
...@@ -49,10 +48,10 @@ package body Osint.C is ...@@ -49,10 +48,10 @@ package body Osint.C is
-- repinfo/list file where xxx is specified extension. -- repinfo/list file where xxx is specified extension.
procedure Set_Library_Info_Name; procedure Set_Library_Info_Name;
-- Sets a default ali file name from the main compiler source name. -- Sets a default ALI file name from the main compiler source name.
-- This is used by Create_Output_Library_Info, and by the version of -- This is used by Create_Output_Library_Info, and by the version of
-- Read_Library_Info that takes a default file name. The name is in -- Read_Library_Info that takes a default file name. The name is in
-- Name_Buffer (with length in Name_Len) on return from the call -- Name_Buffer (with length in Name_Len) on return from the call.
---------------------- ----------------------
-- Close_Debug_File -- -- Close_Debug_File --
...@@ -190,6 +189,7 @@ package body Osint.C is ...@@ -190,6 +189,7 @@ package body Osint.C is
begin begin
if S (S'First) = '.' then if S (S'First) = '.' then
F := Create_Auxiliary_File (Current_Main, S (S'First + 1 .. S'Last)); F := Create_Auxiliary_File (Current_Main, S (S'First + 1 .. S'Last));
else else
Name_Buffer (1 .. S'Length) := S; Name_Buffer (1 .. S'Length) := S;
Name_Len := S'Length + 1; Name_Len := S'Length + 1;
...@@ -212,10 +212,13 @@ package body Osint.C is ...@@ -212,10 +212,13 @@ package body Osint.C is
-- Create_Repinfo_File -- -- Create_Repinfo_File --
------------------------- -------------------------
procedure Create_Repinfo_File (Src : File_Name_Type) is procedure Create_Repinfo_File (Src : String) is
S : constant File_Name_Type := Create_Auxiliary_File (Src, "rep"); Discard : File_Name_Type;
pragma Warnings (Off, S); pragma Warnings (Off, Discard);
begin begin
Name_Buffer (1 .. Src'Length) := Src;
Name_Len := Src'Length;
Discard := Create_Auxiliary_File (Name_Find, "rep");
return; return;
end Create_Repinfo_File; end Create_Repinfo_File;
...@@ -314,7 +317,7 @@ package body Osint.C is ...@@ -314,7 +317,7 @@ package body Osint.C is
declare declare
Name : constant String := Name_Buffer (1 .. Dot_Index); Name : constant String := Name_Buffer (1 .. Dot_Index);
Len : constant Natural := Dot_Index; First : Positive;
begin begin
Name_Buffer (1 .. Output_Object_File_Name'Length) := Name_Buffer (1 .. Output_Object_File_Name'Length) :=
...@@ -328,13 +331,24 @@ package body Osint.C is ...@@ -328,13 +331,24 @@ package body Osint.C is
end if; end if;
end loop; end loop;
-- Dot_Index should be zero now (we check for extension elsewhere) -- Dot_Index should not be zero now (we check for extension
-- elsewhere).
pragma Assert (Dot_Index /= 0); pragma Assert (Dot_Index /= 0);
-- Look for first character of file name
First := Dot_Index;
while First > 1
and then Name_Buffer (First - 1) /= Directory_Separator
and then Name_Buffer (First - 1) /= '/'
loop
First := First - 1;
end loop;
-- Check name of object file is what we expect -- Check name of object file is what we expect
if Name /= Name_Buffer (Dot_Index - Len + 1 .. Dot_Index) then if Name /= Name_Buffer (First .. Dot_Index) then
Fail ("incorrect object file name"); Fail ("incorrect object file name");
end if; end if;
end; end;
...@@ -471,5 +485,4 @@ begin ...@@ -471,5 +485,4 @@ begin
Opt.Close_List_File_Access := Close_List_File'Access; Opt.Close_List_File_Access := Close_List_File'Access;
Set_Program (Compiler); Set_Program (Compiler);
end Osint.C; end Osint.C;
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2001-2006, Free Software Foundation, Inc. -- -- Copyright (C) 2001-2007, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -91,9 +91,10 @@ package Osint.C is ...@@ -91,9 +91,10 @@ package Osint.C is
-- procedures in appropriate variables in Repinfo, so that they can -- procedures in appropriate variables in Repinfo, so that they can
-- be called indirectly without creating a dependence. -- be called indirectly without creating a dependence.
procedure Create_Repinfo_File (Src : File_Name_Type); procedure Create_Repinfo_File (Src : String);
-- Given the simple name of a source file, this routine creates the -- Given the simple name of a source file, this routine creates the
-- corresponding file to hold representation information -- corresponding file to hold representation information. Note that the
-- call destroys the contents of Name_Buffer and Name_Len.
procedure Write_Repinfo_Line (Info : String); procedure Write_Repinfo_Line (Info : String);
-- Writes contents of given string as next line of the current debug -- Writes contents of given string as next line of the current debug
......
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