http://gcc.gnu.org/bugzilla/show_bug.cgi?id=47880
Summary: Free in System.Pool_Local raises Storage_Error
Product: gcc
Version: 4.5.0
Status: UNCONFIRMED
Severity: minor
Priority: P3
Component: ada
AssignedTo: [email protected]
ReportedBy: [email protected]
Created attachment 23451
--> http://gcc.gnu.org/bugzilla/attachment.cgi?id=23451
Short test to raise Storage_Error in local pool
The attached code should not raise Storage_Error.
NOTE - using System.Pool_Global.Unbounded_No_Reclaim_Pool
(commented out) instead of the pool shown, works as expected.
Using Free on a local pool is atypical since the entire pool is
usually freed when the program leaves its scope.
However it ought to be valid, since a Deallocate method is provided in
s-pooloc.ads/b and Free is not explicitly prohibited.
(Tested on GCC4.5.0 and Adacore Libre 2010, confirmed by Ludovic Brenta on
4.4.5, 4.5.2)
Discussion on comp.lang.ada (by Ludovic Brenta) reveals the following...
This looks like a genuine bug at s-pooloc.adb:114. To trigger the bug,
two conditions must hold simultaneously:
* the pool contains exactly one allocated object.
* the user calls Unchecked_Deallocation on this object.
The buggy code is:
procedure Deallocate
(Pool : in out Unbounded_Reclaim_Pool;
Address : System.Address;
Storage_Size : SSE.Storage_Count;
Alignment : SSE.Storage_Count)
is
pragma Warnings (Off, Storage_Size);
pragma Warnings (Off, Alignment);
Allocated : constant System.Address := Address - Pointers_Size;
begin
if Prev (Allocated).all = Null_Address then
Pool.First := Next (Allocated).all;
Prev (Pool.First).all := Null_Address; ------- <- Storage_Error
else
Next (Prev (Allocated).all).all := Next (Allocated).all;
end if;
if Next (Allocated).all /= Null_Address then
Prev (Next (Allocated).all).all := Prev (Allocated).all;
end if;
Memory.Free (Allocated);
end Deallocate;
