From patchwork Fri Jun 18 12:50:15 2010 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 56178 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) by ozlabs.org (Postfix) with SMTP id 9FF901007D4 for ; Fri, 18 Jun 2010 22:50:11 +1000 (EST) Received: (qmail 26613 invoked by alias); 18 Jun 2010 12:50:09 -0000 Received: (qmail 26586 invoked by uid 22791); 18 Jun 2010 12:50:07 -0000 X-SWARE-Spam-Status: No, hits=-0.5 required=5.0 tests=AWL, BAYES_50, T_RP_MATCHES_RCVD X-Spam-Check-By: sourceware.org Received: from mel.act-europe.fr (HELO mel.act-europe.fr) (212.99.106.210) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Fri, 18 Jun 2010 12:49:59 +0000 Received: from localhost (localhost [127.0.0.1]) by filtered-smtp.eu.adacore.com (Postfix) with ESMTP id EE0AB290007; Fri, 18 Jun 2010 14:50:05 +0200 (CEST) Received: from mel.act-europe.fr ([127.0.0.1]) by localhost (smtp.eu.adacore.com [127.0.0.1]) (amavisd-new, port 10024) with ESMTP id iK9Z1PtY8eNR; Fri, 18 Jun 2010 14:50:05 +0200 (CEST) Received: from saumur.act-europe.fr (saumur.act-europe.fr [10.10.0.183]) by mel.act-europe.fr (Postfix) with ESMTP id D87DF290006; Fri, 18 Jun 2010 14:50:05 +0200 (CEST) Received: by saumur.act-europe.fr (Postfix, from userid 525) id 0B3DBD9B31; Fri, 18 Jun 2010 14:50:15 +0200 (CEST) Date: Fri, 18 Jun 2010 14:50:15 +0200 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Robert A Duff Subject: [Ada] Perfect_Hash_Generators cleanup Message-ID: <20100618125015.GA32218@adacore.com> Mime-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.9i X-IsSubscribed: yes Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org This patch cleans up some of the code, and adds better error handling. Tested on x86_64-pc-linux-gnu, committed on trunk 2010-06-18 Bob Duff * 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. Index: g-pehage.adb =================================================================== --- g-pehage.adb (revision 160959) +++ g-pehage.adb (working copy) @@ -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_Generator 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_Generator 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_Generator -- 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_Generator 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_Generator 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); Index: g-pehage.ads =================================================================== --- g-pehage.ads (revision 160959) +++ g-pehage.ads (working copy) @@ -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