From 2bc58d4d59d22e8e8dacd5ab60d802e32fd2954c Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Fri, 10 Sep 2010 11:11:44 +0200 Subject: [PATCH] [multiple changes] 2010-09-10 Robert Dewar * einfo.adb: Minor code cleanup: Add assertion to Set_Corresponding_Protected_Entry. 2010-09-10 Bob Duff * g-pehage.ads, g-pehage.adb (Produce): Add a new flag to allow sending the output to standard output. From-SVN: r164145 --- gcc/ada/ChangeLog | 10 +++++++++ gcc/ada/einfo.adb | 1 + gcc/ada/g-pehage.adb | 52 +++++++++++++++++++++++++++++--------------- gcc/ada/g-pehage.ads | 10 +++++---- 4 files changed, 51 insertions(+), 22 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 6822a1756c9..6e81788636a 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,13 @@ +2010-09-10 Robert Dewar + + * einfo.adb: Minor code cleanup: Add assertion to + Set_Corresponding_Protected_Entry. + +2010-09-10 Bob Duff + + * g-pehage.ads, g-pehage.adb (Produce): Add a new flag to allow sending + the output to standard output. + 2010-09-09 Vincent Celier * gnat_ugn.texi: Add documentation for new gnatmake switch diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index 231089548c2..24461c29db7 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -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; diff --git a/gcc/ada/g-pehage.adb b/gcc/ada/g-pehage.adb index 1b480182441..c637d1c0d0b 100644 --- a/gcc/ada/g-pehage.adb +++ b/gcc/ada/g-pehage.adb @@ -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; diff --git a/gcc/ada/g-pehage.ads b/gcc/ada/g-pehage.ads index dfe926ef782..c1954796eed 100644 --- a/gcc/ada/g-pehage.ads +++ b/gcc/ada/g-pehage.ads @@ -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. ----------------------------------------------------------------