From mboxrd@z Thu Jan  1 00:00:00 1970
X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on polar.synack.me
X-Spam-Level: 
X-Spam-Status: No, score=-1.9 required=5.0 tests=BAYES_00 autolearn=ham
	autolearn_force=no version=3.4.4
X-Google-Language: ENGLISH,ASCII-7-bit
X-Google-Thread: 103376,5648ae085d08220c,start
X-Google-Attributes: gid103376,public
X-Google-ArrivalTime: 2003-09-03 13:32:03 PST
Path: 
 archiver1.google.com!news1.google.com!newsfeed.stanford.edu!bloom-beacon.mit.edu!news.rediris.es!aotearoa.belnet.be!news.belnet.be!newsfeed.wxs.nl!news2.euro.net!newspeer1-gui.server.ntli.net!ntli.net!newsfep4-glfd.server.ntli.net.POSTED!53ab2750!not-for-mail
From: chris <spamoff.danx@ntlworld.com>
User-Agent: Mozilla/5.0 (X11; U; Linux i686; en-US;
 rv:1.5b) Gecko/20030829 Thunderbird/0.2a
X-Accept-Language: en-us, en
MIME-Version: 1.0
Newsgroups: comp.lang.ada
Subject: Types or ranges problem...
Content-Type: text/plain; charset=us-ascii; format=flowed
Content-Transfer-Encoding: 7bit
Message-ID: <6ds5b.507$1%2.8224@newsfep4-glfd.server.ntli.net>
Date: Wed, 03 Sep 2003 21:35:42 +0200
NNTP-Posting-Host: 81.98.236.164
X-Complaints-To: abuse@ntlworld.com
X-Trace: newsfep4-glfd.server.ntli.net 1062621122 81.98.236.164 (Wed,
 03 Sep 2003 21:32:02 BST)
NNTP-Posting-Date: Wed, 03 Sep 2003 21:32:02 BST
Organization: ntl Cablemodem News Service
Xref: archiver1.google.com comp.lang.ada:42113
Date: 2003-09-03T21:35:42+02:00
List-Id: <comp.lang.ada>

Hi,

Test code for a controlled type is generating a constraint error but I'm 
at a loss as to how to fix it.

The code is meant to work as follows.  A efloat_colour is created by 
supplying a unconstrained array of efloat values to 'create'.  This 
creates an array of duplicate size and range, copies the float values 
and keeps it.  Upon assignment another copy is made of the same way and 
the values copied to the new array.  Finalization destroys the array and 
tidies up.  Everyone has their own copy of the values and everyone is 
happy!  They're immutable!

The assignment works to a degree, but it appears the ranges break and 
yet don't...


    subtype Sample_Floats is EFloat_Array (1..4);
    SCF_Data : Sample_Floats   := (1.5, 2.25, 3.125, 4.0625);


    -- test assignment
    --
    procedure Test_Assignment (T : in out 
Aunit.Test_Cases.Test_Case'Class) is
       A, B : EFloat_Colours.EFloat_Colour;
    use EFloat_Colours;
    begin
       EFloat_Colours.Create (A, SCF_Data);
       B := A;

       Assert (EFloat_Colours.Value(B) = SCF_Data,
               "Values of original and copy differ");
    end Test_Assignment;


Here the range of the result of Value(B) is the same as SCF_Data, right? 
So why does this fail below?  The constraint error occurs at "X := 
EFloat_Colours.Value(B)" line in the following test.


    -- test that a copy isn't linked to the existance of the original.
    --
    procedure Test_Assignment_Independance (T : in out 
Aunit.Test_Cases.Test_Case'Class) is
       B : EFloat_Colours.EFloat_Colour;
       X : Sample_Floats;
    use EFloat_Colours;
    begin
       declare
          A : EFloat_Colours.EFloat_Colour;
       begin
          EFloat_Colours.Create (A, SCF_Data);
          B := A;
       end;

       X := EFloat_Colours.Value (B); -- !!!

       for Count in SCF_Data'Range loop
          Assert (X(Count) = SCF_Data (Count),
                  "Values of copy differ from those expected! " &
                  "Expected " & EFloat'Image (SCF_Data(Count)) & " got " 
& EFloat'Image (X(Count)) &
                  " for " & EInteger'Image(count) & " component.");

       end loop;
    end Test_Assignment_Independance;


I added the X := blah line to the first test and it passed!  Why does A 
being destroyed cause it to go mad?  I think there is a suspect in the 
assign procedure, marked with stars.  Assuming that is the problem, how 
can it be resolved?



Cheers,
Chris

-- code

    -- Float types
    --
    type EFloat                is digits 6;
    type EFloat_Array          is array (EInteger range <>) of EFloat;
    type EFloat_Array_Access   is access EFloat_Array;


    type EFloat_Colour is new Colour with record
       values : EFloat_Array_Access;
    end record;

    procedure Create (C : out EFloat_Colour;
                      V : in  EFloat_Array) is
       Tmp : EFloat_Array_Access;
    begin
       Tmp      := new EFloat_Array(V'Range);
       Tmp.all  := V;
       C.Values := Tmp;
    end Create;

    function Value (C : in EFloat_Colour) return EFloat_Array is
    begin
       return C.Values.all;
    end Value;


    procedure Assign   (Object : in out EFloat_Colour) is
       Tmp : EFloat_Array_Access;
    begin
       if Object.Values /= null then
         Tmp            := new EFloat_Array(Object.Values.all'Range);
         Tmp(Tmp.all'Range) := Object.Values(Tmp.all'Range);
         Object.Values  := Tmp; -- **** here, maybe? ****
       end if;
    end Assign;


    procedure Finalize (Object : in out EFloat_Colour) is
    begin
       if Object.Values /= null then
          Free (Object.Values);
          Object.Values := null;
       end if;
    end Finalize;