Re: Limited type in generic package causes double free or corruption

[Anh Vo <anhvofrcaus@gmail.com>]

On Wednesday, September 28, 2016 at 6:26:02 AM UTC-7, onox wrote:
> I have a generic package (A) with a limited type (Tree). The generic package is used as a generic formal parameter in another generic package (B). This second generic package has a primitive operation (Get_Tree) that returns a component of a tagged record that is of that limited type. Calling that primitive operation results in a "double free or corruption (fasttop)" message when the program terminates.
> 
> Shouldn't the compiler (GNAT GPL 2015) check that the type in the generic formal parameter (package) is limited and forbid the copying operation? If I remove the "limited" keyword from the type, then the program terminates without any errors.
> 
> Compile via gnatmake c.adb
> 
> I put the example in a separate task, otherwise the program could just hang with 100 % CPU instead of displaying the error and terminating.
> 
> onox
> 
> --  File a.ads
> private with Ada.Containers.Vectors;
> 
> generic
>    Foo : Positive;
> package A is
> 
>    --  Remove "limited" keyword to avoid double-free or corruption
>    type Tree is tagged limited private;
> 
>    function Create_Tree return Tree;
> 
> private
> 
>    package Level_Vectors is new Ada.Containers.Vectors (Positive, Positive);
> 
>    --  Remove "limited" keyword to avoid double-free or corruption
>    type Tree is tagged limited record
>       Levels : Level_Vectors.Vector;
>    end record;
> 
> end A;
> --  End of file a.ads
> 
> --  File a.adb
> package body A is
> 
>    function Create_Tree return Tree is
>    begin
>       return Object : Tree do
>          Object.Levels.Append (10);
>       end return;
>    end Create_Tree;
> 
> end A;
> --  End of file a.adb
> 
> --  File b.ads
> with A;
> 
> generic
>    with package Trees is new A (<>);
> package B is
> 
>    type Thing is tagged limited private;
> 
>    function Load_Thing return Thing;
> 
>    function Get_Tree (Object : Thing) return Trees.Tree;
> 
> private
> 
>    type Thing is tagged limited record
>       My_Tree : Trees.Tree;
>    end record;
> 
> end B;
> --  End of file b.ads
> 
> --  File b.adb
> package body B is
> 
>    function Load_Thing return Thing is
>    begin
>       return Object : Thing := (My_Tree => Trees.Create_Tree) do
>          null;
>       end return;
>    end Load_Thing;
> 
>    --  If Trees.Tree (A.Tree) is limited, shouldn't this function be disallowed?
>    function Get_Tree (Object : Thing) return Trees.Tree is
>      (Object.My_Tree);
> 
> end B;
> --  End of file b.adb
> 
> --  File c.adb
> with Ada.Text_IO;
> with A;
> with B;
> 
> procedure C is
> 
>    task Worker;
> 
>    task body Worker is
>       package AA is new A (1);
>       use AA;
>       package Things is new B (AA);
> 
>       M : Things.Thing := Things.Load_Thing;
>       T : Tree := M.Get_Tree;
>    begin
>       Ada.Text_IO.Put_Line ("Worker thread");
>    end Worker;
> 
> begin
>    Ada.Text_IO.Put_Line ("Environment thread");
> end C;
> --  End of file c.adb

Your codes work fine under GNAT GPL 2016. Of course, you need to pass compiler flag -gnat2012 during compilation.

Anh Vo