[multiple changes]

2010-09-10  Robert Dewar  <dewar@adacore.com>

	* einfo.adb: Minor code cleanup: Add assertion to
	Set_Corresponding_Protected_Entry.

2010-09-10  Bob Duff  <duff@adacore.com>

	* g-pehage.ads, g-pehage.adb (Produce): Add a new flag to allow sending
	the output to standard output.

From-SVN: r164145
This commit is contained in:
Arnaud Charlet 2010-09-10 11:11:44 +02:00
parent 2b74262bfc
commit 2bc58d4d59
4 changed files with 51 additions and 22 deletions

View File

@ -1,3 +1,13 @@
2010-09-10 Robert Dewar <dewar@adacore.com>
* einfo.adb: Minor code cleanup: Add assertion to
Set_Corresponding_Protected_Entry.
2010-09-10 Bob Duff <duff@adacore.com>
* g-pehage.ads, g-pehage.adb (Produce): Add a new flag to allow sending
the output to standard output.
2010-09-09 Vincent Celier <celier@adacore.com>
* gnat_ugn.texi: Add documentation for new gnatmake switch

View File

@ -3124,6 +3124,7 @@ package body Einfo is
procedure Set_Corresponding_Protected_Entry (Id : E; V : E) is
begin
pragma Assert (Ekind_In (Id, E_Void, E_Subprogram_Body));
Set_Node18 (Id, V);
end Set_Corresponding_Protected_Entry;

View File

@ -1431,8 +1431,11 @@ package body GNAT.Perfect_Hash_Generators is
-- Produce --
-------------
procedure Produce (Pkg_Name : String := Default_Pkg_Name) is
File : File_Descriptor;
procedure Produce
(Pkg_Name : String := Default_Pkg_Name;
Use_Stdout : Boolean := False)
is
File : File_Descriptor := Standout;
Status : Boolean;
-- For call to Close
@ -1525,23 +1528,25 @@ package body GNAT.Perfect_Hash_Generators is
P : Natural;
FName : String := Ada_File_Base_Name (Pkg_Name) & ".ads";
-- Initially, the name of the spec file; then modified to be the name of
-- the body file.
-- Initially, the name of the spec file, then modified to be the name of
-- the body file. Not used if Use_Stdout is True.
-- Start of processing for Produce
begin
if Verbose then
if Verbose and then not Use_Stdout then
Put (Output,
"Producing " & Ada.Directories.Current_Directory & "/" & FName);
New_Line (Output);
end if;
File := Create_File (FName, Binary);
if not Use_Stdout then
File := Create_File (FName, Binary);
if File = Invalid_FD then
raise Program_Error with "cannot create: " & FName;
if File = Invalid_FD then
raise Program_Error with "cannot create: " & FName;
end if;
end if;
Put (File, "package ");
@ -1554,18 +1559,26 @@ package body GNAT.Perfect_Hash_Generators is
Put (File, Pkg_Name);
Put (File, ";");
New_Line (File);
Close (File, Status);
if not Status then
raise Device_Error;
if not Use_Stdout then
Close (File, Status);
if not Status then
raise Device_Error;
end if;
end if;
FName (FName'Last) := 'b'; -- Set to body file name
if not Use_Stdout then
File := Create_File (FName, Binary);
-- Set to body file name
if File = Invalid_FD then
raise Program_Error with "cannot create: " & FName;
FName (FName'Last) := 'b';
File := Create_File (FName, Binary);
if File = Invalid_FD then
raise Program_Error with "cannot create: " & FName;
end if;
end if;
Put (File, "with Interfaces; use Interfaces;");
@ -1738,10 +1751,13 @@ package body GNAT.Perfect_Hash_Generators is
Put (File, Pkg_Name);
Put (File, ";");
New_Line (File);
Close (File, Status);
if not Status then
raise Device_Error;
if not Use_Stdout then
Close (File, Status);
if not Status then
raise Device_Error;
end if;
end if;
end Produce;

View File

@ -131,11 +131,13 @@ package GNAT.Perfect_Hash_Generators is
-- Raise Too_Many_Tries if the algorithm does not succeed within Tries
-- attempts (see Initialize).
procedure Produce (Pkg_Name : String := Default_Pkg_Name);
procedure Produce
(Pkg_Name : String := Default_Pkg_Name; Use_Stdout : Boolean := False);
-- Generate the hash function package Pkg_Name. This package includes the
-- minimal perfect Hash function. The output is placed in the current
-- directory, in files X.ads and X.adb, where X is the standard GNAT file
-- name for a package named Pkg_Name.
-- minimal perfect Hash function. The output is normally placed in the
-- current directory, in files X.ads and X.adb, where X is the standard
-- GNAT file name for a package named Pkg_Name. If Use_Stdout is True, the
-- output goes to standard output, and no files are written.
----------------------------------------------------------------