Skip to content

R
riscv-gcc-1
Commit 175d6559 by Bob Duff Committed by Arnaud Charlet
Options

g-pehage.ads, [...] (Produce): Clean up some of the code. 

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.

From-SVN: r160985
parent 709121b5
Showing with 48 additions and 21 deletions
gcc/ada/ChangeLog
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
......
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);
......
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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment