Types or ranges problem...

Types or ranges problem...

[chris]

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;

Re: Types or ranges problem...

[chris]

chris wrote:
> Hi,
> 
> Test code for a controlled type is generating a constraint error but I'm 
> at a loss as to how to fix it.

Oops!  Should be a polite plea for help there... sorry.


Can someone please shed some light on it?


Thanks,
Chris

Re: Types or ranges problem...

[Jeffrey Carter]

chris wrote:
>>
>> Test code for a controlled type is generating a constraint error but 
>> I'm at a loss as to how to fix it.
> 
> Oops!  Should be a polite plea for help there... sorry.
> 
> Can someone please shed some light on it?

Try overriding Adjust.

-- 
Jeff Carter
"This school was here before you came,
and it'll be here before you go."
Horse Feathers
48

Re: Types or ranges problem...

[chris]

Jeffrey Carter wrote:
> chris wrote:
> 
> Try overriding Adjust.

Thanks Jeff.  Why did I write Assign?  :<

Idiot!!!


Thanks again,
Chris