This patch fixes GNAT.Perfect_Hash_Generators for strings which are
not 1-based. It does this by introducing its own storage type which
fixes the first index as 1. This is also a minor optimization because
it avoids the need to store the index.
Okay for trunk?
Should I try to construct a new test case for this? I don't see any
existing tests for this package.
2016-09-08 Florian Weimer <f...@deneb.enyo.de>
PR ada/77535
Make all word strings start with 1.
* g-pehage.adb (Word_Storage): New type.
(Word_Type): Use Word_Storage.
(Free_Word): Instantiate Unchecked_Deallocation.
(Apply_Position_Selection, Put_Initial_Keys, Put_Reduced_Keys)
(Resize_Word, Select_Char_Position, Select_Character_Set): Adjust
indirection through Word_Type.
(New_Word): Allocate Word_Storage instead of String.
Index: gcc/ada/g-pehage.adb
===================================================================
--- gcc/ada/g-pehage.adb (revision 240038)
+++ gcc/ada/g-pehage.adb (working copy)
@@ -32,6 +32,7 @@
with Ada.IO_Exceptions; use Ada.IO_Exceptions;
with Ada.Characters.Handling; use Ada.Characters.Handling;
with Ada.Directories;
+with Ada.Unchecked_Deallocation;
with GNAT.Heap_Sort_G;
with GNAT.OS_Lib; use GNAT.OS_Lib;
@@ -102,8 +103,12 @@
No_Edge : constant Edge_Id := -1;
No_Table : constant Table_Id := -1;
- type Word_Type is new String_Access;
- procedure Free_Word (W : in out Word_Type) renames Free;
+ type Word_Storage (Length : Natural) is record
+ Word : String (1 .. Length);
+ end record;
+ type Word_Type is access Word_Storage;
+ procedure Free_Word is
+ new Ada.Unchecked_Deallocation (Word_Storage, Word_Type);
function New_Word (S : String) return Word_Type;
procedure Resize_Word (W : in out Word_Type; Len : Natural);
@@ -574,7 +579,7 @@
begin
for J in 0 .. NK - 1 loop
declare
- IW : constant String := WT.Table (Initial (J)).all;
+ IW : constant String := WT.Table (Initial (J)).Word;
RW : String (1 .. IW'Length) := (others => ASCII.NUL);
N : Natural := IW'First - 1;
@@ -1312,7 +1317,8 @@
function New_Word (S : String) return Word_Type is
begin
- return new String'(S);
+ return new Word_Storage'(Length => S'Length,
+ Word => S);
end New_Word;
------------------------------
@@ -1913,7 +1919,7 @@
K := Get_Key (J);
Put (File, Image (J, M), F1, L1, J, 1, 3, 1);
Put (File, Image (K.Edge, M), F1, L1, J, 1, 3, 2);
- Put (File, Trim_Trailing_Nuls (WT.Table (Initial (J)).all),
+ Put (File, Trim_Trailing_Nuls (WT.Table (Initial (J)).Word),
F1, L1, J, 1, 3, 3);
end loop;
end Put_Initial_Keys;
@@ -1995,7 +2001,7 @@
K := Get_Key (J);
Put (File, Image (J, M), F1, L1, J, 1, 3, 1);
Put (File, Image (K.Edge, M), F1, L1, J, 1, 3, 2);
- Put (File, Trim_Trailing_Nuls (WT.Table (Reduced (J)).all),
+ Put (File, Trim_Trailing_Nuls (WT.Table (Reduced (J)).Word),
F1, L1, J, 1, 3, 3);
end loop;
end Put_Reduced_Keys;
@@ -2075,7 +2081,7 @@
-----------------
procedure Resize_Word (W : in out Word_Type; Len : Natural) is
- S1 : constant String := W.all;
+ S1 : constant String := W.Word;
S2 : String (1 .. Len) := (others => ASCII.NUL);
L : constant Natural := S1'Length;
begin
@@ -2161,7 +2167,7 @@
Right := Offset + R;
end if;
- return WT.Table (Left)(C) < WT.Table (Right)(C);
+ return WT.Table (Left).Word (C) < WT.Table (Right).Word (C);
end Lt;
----------
@@ -2221,8 +2227,8 @@
-- Two contiguous words are identical when they have the
-- same Cth character.
- elsif WT.Table (Reduced (N))(C) =
- WT.Table (Reduced (N + 1))(C)
+ elsif WT.Table (Reduced (N)).Word (C) =
+ WT.Table (Reduced (N + 1)).Word (C)
then
L := N + 1;
@@ -2265,7 +2271,7 @@
N := (others => 0);
for K in Table (S).First .. Table (S).Last loop
- C := WT.Table (Reduced (K))(Pos);
+ C := WT.Table (Reduced (K)).Word (Pos);
N (C) := N (C) + 1;
end loop;
@@ -2288,7 +2294,7 @@
-- Initialize the reduced words set
for K in 0 .. NK - 1 loop
- WT.Table (Reduced (K)) := New_Word (WT.Table (Initial (K)).all);
+ WT.Table (Reduced (K)) := New_Word (WT.Table (Initial (K)).Word);
end loop;
declare
@@ -2384,7 +2390,7 @@
Same_Keys_Sets_Table (J).Last
loop
Put (Output,
- Trim_Trailing_Nuls (WT.Table (Reduced (K)).all));
+ Trim_Trailing_Nuls (WT.Table (Reduced (K)).Word));
New_Line (Output);
end loop;
Put (Output, "--");
@@ -2414,7 +2420,7 @@
begin
for J in 0 .. NK - 1 loop
for K in 0 .. Char_Pos_Set_Len - 1 loop
- Char := WT.Table (Initial (J))(Get_Char_Pos (K));
+ Char := WT.Table (Initial (J)).Word (Get_Char_Pos (K));
exit when Char = ASCII.NUL;
Used (Char) := True;
end loop;
@@ -2520,16 +2526,16 @@
case Opt is
when CPU_Time =>
for J in 0 .. T1_Len - 1 loop
- exit when Word (J + 1) = ASCII.NUL;
- R := Get_Table (Table, J, Get_Used_Char (Word (J + 1)));
+ exit when Word.Word (J + 1) = ASCII.NUL;
+ R := Get_Table (Table, J, Get_Used_Char (Word.Word (J + 1)));
S := (S + R) mod NV;
end loop;
when Memory_Space =>
for J in 0 .. T1_Len - 1 loop
- exit when Word (J + 1) = ASCII.NUL;
+ exit when Word.Word (J + 1) = ASCII.NUL;
R := Get_Table (Table, J, 0);
- S := (S + R * Character'Pos (Word (J + 1))) mod NV;
+ S := (S + R * Character'Pos (Word.Word (J + 1))) mod NV;
end loop;
end case;
