2010-06-18 Bob Duff <duff@adacore.com>

	* g-pehage.ads, g-pehage.adb (Produce): Clean up some of the code.
	Raise an exception if the output file cannot be opened. Add comments.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@160985 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 8653b02..f177911 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,8 @@
+2010-06-18  Bob Duff  <duff@adacore.com>
+
+       * g-pehage.ads, g-pehage.adb (Produce): Clean up some of the code.
+       Raise an exception if the output file cannot be opened. Add comments.
+
 2010-06-18  Thomas Quinot  <quinot@adacore.com>
 
        * sem_cat.adb (Validate_Object_Declaration): A variable declaration is

diff --git a/gcc/ada/g-pehage.adb b/gcc/ada/g-pehage.adb
index e96b9cc..b63bc7a 100644 (file)
--- a/gcc/ada/g-pehage.adb
+++ b/gcc/ada/g-pehage.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---                     Copyright (C) 2002-2009, AdaCore                     --
+--                     Copyright (C) 2002-2010, AdaCore                     --
 --                                                                          --
 -- 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- --
@@ -32,6 +32,7 @@
 ------------------------------------------------------------------------------
 
 with Ada.IO_Exceptions; use Ada.IO_Exceptions;
+with Ada.Characters.Handling; use Ada.Characters.Handling;
 
 with GNAT.Heap_Sort_G;
 with GNAT.OS_Lib;      use GNAT.OS_Lib;
@@ -213,6 +214,12 @@ package body GNAT.Perfect_Hash_Generators is
    procedure Put_Vertex_Table (File : File_Descriptor; Title : String);
    --  Output a title and a vertex table
 
+   function Ada_File_Base_Name (Pkg_Name : String) return String;
+   --  Return the base file name (i.e. without .ads/.adb extension) for an Ada
+   --  source file containing the named package, using the standard GNAT
+   --  file-naming convention. For example, if Pkg_Name is "Parent.Child", we
+   --  return "parent-child".
+
    ----------------------------------
    -- Character Position Selection --
    ----------------------------------
@@ -494,6 +501,23 @@ package body GNAT.Perfect_Hash_Generators is
       return True;
    end Acyclic;
 
+   ------------------------
+   -- Ada_File_Base_Name --
+   ------------------------
+
+   function Ada_File_Base_Name (Pkg_Name : String) return String is
+   begin
+      --  Convert to lower case, then replace '.' with '-'
+
+      return Result : String := To_Lower (Pkg_Name) do
+         for J in Result'Range loop
+            if Result (J) = '.' then
+               Result (J) := '-';
+            end if;
+         end loop;
+      end return;
+   end Ada_File_Base_Name;
+
    ---------
    -- Add --
    ---------
@@ -1369,7 +1393,7 @@ package body GNAT.Perfect_Hash_Generators is
    -- Produce --
    -------------
 
-   procedure Produce (Pkg_Name  : String := Default_Pkg_Name) is
+   procedure Produce (Pkg_Name : String := Default_Pkg_Name) is
       File : File_Descriptor;
 
       Status : Boolean;
@@ -1462,27 +1486,18 @@ package body GNAT.Perfect_Hash_Generators is
       L : Natural;
       P : Natural;
 
-      PLen  : constant Natural := Pkg_Name'Length;
-      FName : String (1 .. PLen + 4);
+      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.
 
    --  Start of processing for Produce
 
    begin
-      FName (1 .. PLen) := Pkg_Name;
-      for J in 1 .. PLen loop
-         if FName (J) in 'A' .. 'Z' then
-            FName (J) := Character'Val (Character'Pos (FName (J))
-                                        - Character'Pos ('A')
-                                        + Character'Pos ('a'));
-
-         elsif FName (J) = '.' then
-            FName (J) := '-';
-         end if;
-      end loop;
-
-      FName (PLen + 1 .. PLen + 4) := ".ads";
 
       File := Create_File (FName, Binary);
+      if File = Invalid_FD then
+         raise Program_Error with "cannot create: " & FName;
+      end if;
 
       Put      (File, "package ");
       Put      (File, Pkg_Name);
@@ -1500,9 +1515,12 @@ package body GNAT.Perfect_Hash_Generators is
          raise Device_Error;
       end if;
 
-      FName (PLen + 4) := 'b';
+      FName (FName'Last) := 'b';  --  Set to body file name
 
       File := Create_File (FName, Binary);
+      if File = Invalid_FD then
+         raise Program_Error with "cannot create: " & FName;
+      end if;
 
       Put      (File, "with Interfaces; use Interfaces;");
       New_Line (File);

diff --git a/gcc/ada/g-pehage.ads b/gcc/ada/g-pehage.ads
index e4d0e90..c01c285 100644 (file)
--- a/gcc/ada/g-pehage.ads
+++ b/gcc/ada/g-pehage.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---                     Copyright (C) 2002-2008, AdaCore                     --
+--                     Copyright (C) 2002-2010, AdaCore                     --
 --                                                                          --
 -- 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- --
@@ -130,9 +130,13 @@ package GNAT.Perfect_Hash_Generators is
    --  Raise Too_Many_Tries in case that the algorithm does not succeed in less
    --  than Tries attempts (see Initialize).
 
-   procedure Produce (Pkg_Name  : String := Default_Pkg_Name);
+   procedure Produce (Pkg_Name : String := Default_Pkg_Name);
    --  Generate the hash function package Pkg_Name. This package includes the
-   --  minimal perfect Hash function.
+   --  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.
+
+   ----------------------------------------------------------------
 
    --  The routines and structures defined below allow producing the hash
    --  function using a different way from the procedure above. The procedure