From 4320e73005b2d4a3a0d85e00e2e52e9614b16442 Mon Sep 17 00:00:00 2001 From: charlet Date: Fri, 18 Jun 2010 12:49:46 +0000 Subject: [PATCH] 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. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@160985 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/ChangeLog | 5 +++++ gcc/ada/g-pehage.adb | 54 ++++++++++++++++++++++++++++++++++------------------ gcc/ada/g-pehage.ads | 10 +++++++--- 3 files changed, 48 insertions(+), 21 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 8653b02..f177911 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +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. + 2010-06-18 Thomas Quinot * 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 --- 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 --- 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 -- 2.7.4