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
This commit is contained in:
Vincent Celier 2007-06-06 12:38:46 +02:00 committed by Arnaud Charlet
parent b5755e2ba5
commit 717809895b
2 changed files with 29 additions and 15 deletions

View File

@ -6,7 +6,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -25,7 +25,6 @@
------------------------------------------------------------------------------
with Hostparm;
with Namet; use Namet;
with Opt; use Opt;
with Tree_IO; use Tree_IO;
@ -49,10 +48,10 @@ package body Osint.C is
-- repinfo/list file where xxx is specified extension.
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
-- 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 --
@ -190,6 +189,7 @@ package body Osint.C is
begin
if S (S'First) = '.' then
F := Create_Auxiliary_File (Current_Main, S (S'First + 1 .. S'Last));
else
Name_Buffer (1 .. S'Length) := S;
Name_Len := S'Length + 1;
@ -212,10 +212,13 @@ package body Osint.C is
-- Create_Repinfo_File --
-------------------------
procedure Create_Repinfo_File (Src : File_Name_Type) is
S : constant File_Name_Type := Create_Auxiliary_File (Src, "rep");
pragma Warnings (Off, S);
procedure Create_Repinfo_File (Src : String) is
Discard : File_Name_Type;
pragma Warnings (Off, Discard);
begin
Name_Buffer (1 .. Src'Length) := Src;
Name_Len := Src'Length;
Discard := Create_Auxiliary_File (Name_Find, "rep");
return;
end Create_Repinfo_File;
@ -313,8 +316,8 @@ package body Osint.C is
-- Remove extension preparing to replace it
declare
Name : constant String := Name_Buffer (1 .. Dot_Index);
Len : constant Natural := Dot_Index;
Name : constant String := Name_Buffer (1 .. Dot_Index);
First : Positive;
begin
Name_Buffer (1 .. Output_Object_File_Name'Length) :=
@ -328,13 +331,24 @@ package body Osint.C is
end if;
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);
-- 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
if Name /= Name_Buffer (Dot_Index - Len + 1 .. Dot_Index) then
if Name /= Name_Buffer (First .. Dot_Index) then
Fail ("incorrect object file name");
end if;
end;
@ -471,5 +485,4 @@ begin
Opt.Close_List_File_Access := Close_List_File'Access;
Set_Program (Compiler);
end Osint.C;

View File

@ -6,7 +6,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -91,9 +91,10 @@ package Osint.C is
-- procedures in appropriate variables in Repinfo, so that they can
-- 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
-- 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);
-- Writes contents of given string as next line of the current debug