This change fixes a seg fault when a local storage pool has a single allocated
object, and Unchecked_Deallocation is used to deallocate that object.
The following test case must compile and execute quietly:
$ gnatmake -q pooltest
$ ./pooltest
with System.Pool_Local;
with Ada.Unchecked_Deallocation;
procedure pooltest is
type Node;
type Treenode is access Node;
type Node is record
Left : Treenode := null;
Right : Treenode := null;
Item : Integer := 0;
end record;
P : System.Pool_Local.Unbounded_Reclaim_Pool;
for Treenode'Storage_Pool use P;
procedure Free is new Ada.Unchecked_Deallocation(Node, Treenode);
TestNode : Treenode;
begin
Testnode := new Node'(null, null, 1);
Free(Testnode);
end pooltest;
Tested on x86_64-pc-linux-gnu, committed on trunk
2011-08-04 Thomas Quinot <qui...@adacore.com>
PR ada/47880
* s-pooloc.adb (Deallocate): Fix the case of deallocating the only
allocated object.
Index: s-pooloc.adb
===================================================================
--- s-pooloc.adb (revision 177274)
+++ s-pooloc.adb (working copy)
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- --
-- 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- --
@@ -111,7 +111,10 @@
begin
if Prev (Allocated).all = Null_Address then
Pool.First := Next (Allocated).all;
- Prev (Pool.First).all := Null_Address;
+
+ if Pool.First /= Null_Address then
+ Prev (Pool.First).all := Null_Address;
+ end if;
else
Next (Prev (Allocated).all).all := Next (Allocated).all;
end if;
