From: chris <spamoff.danx@ntlworld.com>
Subject: Types or ranges problem...
Date: Wed, 03 Sep 2003 21:35:42 +0200
Date: 2003-09-03T21:35:42+02:00 [thread overview]
Message-ID: <6ds5b.507$1%2.8224@newsfep4-glfd.server.ntli.net> (raw)
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;
next reply other threads:[~2003-09-03 19:35 UTC|newest]
Thread overview: 4+ messages / expand[flat|nested] mbox.gz Atom feed top
2003-09-03 19:35 chris [this message]
2003-09-03 19:42 ` Types or ranges problem chris
2003-09-04 1:18 ` Jeffrey Carter
2003-09-04 11:34 ` chris
replies disabled
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox