[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:
parent
2b74262bfc
commit
2bc58d4d59
@ -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>
|
2010-09-09 Vincent Celier <celier@adacore.com>
|
||||||
|
|
||||||
* gnat_ugn.texi: Add documentation for new gnatmake switch
|
* gnat_ugn.texi: Add documentation for new gnatmake switch
|
||||||
|
@ -3124,6 +3124,7 @@ package body Einfo is
|
|||||||
|
|
||||||
procedure Set_Corresponding_Protected_Entry (Id : E; V : E) is
|
procedure Set_Corresponding_Protected_Entry (Id : E; V : E) is
|
||||||
begin
|
begin
|
||||||
|
pragma Assert (Ekind_In (Id, E_Void, E_Subprogram_Body));
|
||||||
Set_Node18 (Id, V);
|
Set_Node18 (Id, V);
|
||||||
end Set_Corresponding_Protected_Entry;
|
end Set_Corresponding_Protected_Entry;
|
||||||
|
|
||||||
|
@ -1431,8 +1431,11 @@ package body GNAT.Perfect_Hash_Generators is
|
|||||||
-- Produce --
|
-- Produce --
|
||||||
-------------
|
-------------
|
||||||
|
|
||||||
procedure Produce (Pkg_Name : String := Default_Pkg_Name) is
|
procedure Produce
|
||||||
File : File_Descriptor;
|
(Pkg_Name : String := Default_Pkg_Name;
|
||||||
|
Use_Stdout : Boolean := False)
|
||||||
|
is
|
||||||
|
File : File_Descriptor := Standout;
|
||||||
|
|
||||||
Status : Boolean;
|
Status : Boolean;
|
||||||
-- For call to Close
|
-- For call to Close
|
||||||
@ -1525,24 +1528,26 @@ package body GNAT.Perfect_Hash_Generators is
|
|||||||
P : Natural;
|
P : Natural;
|
||||||
|
|
||||||
FName : String := Ada_File_Base_Name (Pkg_Name) & ".ads";
|
FName : String := Ada_File_Base_Name (Pkg_Name) & ".ads";
|
||||||
-- Initially, the name of the spec file; then modified to be the name of
|
-- Initially, the name of the spec file, then modified to be the name of
|
||||||
-- the body file.
|
-- the body file. Not used if Use_Stdout is True.
|
||||||
|
|
||||||
-- Start of processing for Produce
|
-- Start of processing for Produce
|
||||||
|
|
||||||
begin
|
begin
|
||||||
|
|
||||||
if Verbose then
|
if Verbose and then not Use_Stdout then
|
||||||
Put (Output,
|
Put (Output,
|
||||||
"Producing " & Ada.Directories.Current_Directory & "/" & FName);
|
"Producing " & Ada.Directories.Current_Directory & "/" & FName);
|
||||||
New_Line (Output);
|
New_Line (Output);
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
|
if not Use_Stdout then
|
||||||
File := Create_File (FName, Binary);
|
File := Create_File (FName, Binary);
|
||||||
|
|
||||||
if File = Invalid_FD then
|
if File = Invalid_FD then
|
||||||
raise Program_Error with "cannot create: " & FName;
|
raise Program_Error with "cannot create: " & FName;
|
||||||
end if;
|
end if;
|
||||||
|
end if;
|
||||||
|
|
||||||
Put (File, "package ");
|
Put (File, "package ");
|
||||||
Put (File, Pkg_Name);
|
Put (File, Pkg_Name);
|
||||||
@ -1554,19 +1559,27 @@ package body GNAT.Perfect_Hash_Generators is
|
|||||||
Put (File, Pkg_Name);
|
Put (File, Pkg_Name);
|
||||||
Put (File, ";");
|
Put (File, ";");
|
||||||
New_Line (File);
|
New_Line (File);
|
||||||
|
|
||||||
|
if not Use_Stdout then
|
||||||
Close (File, Status);
|
Close (File, Status);
|
||||||
|
|
||||||
if not Status then
|
if not Status then
|
||||||
raise Device_Error;
|
raise Device_Error;
|
||||||
end if;
|
end if;
|
||||||
|
end if;
|
||||||
|
|
||||||
FName (FName'Last) := 'b'; -- Set to body file name
|
if not Use_Stdout then
|
||||||
|
|
||||||
|
-- Set to body file name
|
||||||
|
|
||||||
|
FName (FName'Last) := 'b';
|
||||||
|
|
||||||
File := Create_File (FName, Binary);
|
File := Create_File (FName, Binary);
|
||||||
|
|
||||||
if File = Invalid_FD then
|
if File = Invalid_FD then
|
||||||
raise Program_Error with "cannot create: " & FName;
|
raise Program_Error with "cannot create: " & FName;
|
||||||
end if;
|
end if;
|
||||||
|
end if;
|
||||||
|
|
||||||
Put (File, "with Interfaces; use Interfaces;");
|
Put (File, "with Interfaces; use Interfaces;");
|
||||||
New_Line (File);
|
New_Line (File);
|
||||||
@ -1738,11 +1751,14 @@ package body GNAT.Perfect_Hash_Generators is
|
|||||||
Put (File, Pkg_Name);
|
Put (File, Pkg_Name);
|
||||||
Put (File, ";");
|
Put (File, ";");
|
||||||
New_Line (File);
|
New_Line (File);
|
||||||
|
|
||||||
|
if not Use_Stdout then
|
||||||
Close (File, Status);
|
Close (File, Status);
|
||||||
|
|
||||||
if not Status then
|
if not Status then
|
||||||
raise Device_Error;
|
raise Device_Error;
|
||||||
end if;
|
end if;
|
||||||
|
end if;
|
||||||
end Produce;
|
end Produce;
|
||||||
|
|
||||||
---------
|
---------
|
||||||
|
@ -131,11 +131,13 @@ package GNAT.Perfect_Hash_Generators is
|
|||||||
-- Raise Too_Many_Tries if the algorithm does not succeed within Tries
|
-- Raise Too_Many_Tries if the algorithm does not succeed within Tries
|
||||||
-- attempts (see Initialize).
|
-- 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
|
-- Generate the hash function package Pkg_Name. This package includes the
|
||||||
-- minimal perfect Hash function. The output is placed in the current
|
-- minimal perfect Hash function. The output is normally placed in the
|
||||||
-- directory, in files X.ads and X.adb, where X is the standard GNAT file
|
-- current directory, in files X.ads and X.adb, where X is the standard
|
||||||
-- name for a package named Pkg_Name.
|
-- 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.
|
||||||
|
|
||||||
----------------------------------------------------------------
|
----------------------------------------------------------------
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user