|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 23552 (0x5c00)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, procedure Cvt_010, seg_00547b
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦this⟧
with Test_Io;
with Cvt_Test_Utilities;
with Xlbt_Arithmetic;
with Xlbmt_Network_Types;
with Xlbmp_Generic_Converters;
--/ if Record_Rep_Clauses then
--// with Xlbmt_Parameters;
--// use Xlbmt_Parameters;
--/ end if;
procedure Cvt_010 is
------------------------------------------------------------------------------
-- Tests for Xlbmp_Generic_Converters
------------------------------------------------------------------------------
-- 09/05/90 DRK | Created.
------------------------------------------------------------------------------
---------------------------------
-- Handy constants and renames --
---------------------------------
package Utils renames Cvt_Test_Utilities;
package Tests renames Utils.Raw_Data_Tests;
use Utils.Raw_Data_Constants;
----------------------------------------------------------------------
-----------------
-- Local types --
-----------------
type Discrete_S32 is new Xlbt_Arithmetic.S_Long;
type Discrete_S16 is new Xlbt_Arithmetic.S_Short;
type Discrete_U16 is new Xlbt_Arithmetic.U_Short;
type Discrete_S8 is new Xlbt_Arithmetic.S_Char;
type Discrete_U8 is new Xlbt_Arithmetic.U_Char;
type Private_48 is
record
Value_1 : Discrete_S16;
Value_2 : Discrete_S16;
Value_3 : Discrete_S16;
end record;
--/ if Length_Clauses then
for Private_48'Size use 48;
--/ end if;
--/ if Record_Rep_Clauses then
--// for Private_48 use
--// record
--// Value_1 at 0 * X_Word range X_Half0a .. X_Half0b;
--// Value_2 at 0 * X_Word range X_Half1a .. X_Half1b;
--// Value_3 at 1 * X_Word range X_Half0a .. X_Half0b;
--// end record;
--/ end if;
type Private_32 is
record
Value : Discrete_S32;
end record;
--/ if Length_Clauses then
for Private_32'Size use 32;
--/ end if;
type Private_16 is
record
Value : Discrete_S16;
end record;
--/ if Length_Clauses then
for Private_16'Size use 16;
--/ end if;
type Array_S8_Of_U16 is array (Discrete_S8 range <>) of Discrete_U16;
--/ if Pack then
--// pragma Pack (Array_S8_Of_U16);
--/ end if;
type Array_U16_Of_S8 is array (Discrete_U16 range <>) of Discrete_S8;
--/ if Pack then
--// pragma Pack (Array_U16_Of_S8);
--/ end if;
type Array_S16_U16_Of_S8 is
array (Discrete_S16 range <>, Discrete_U16 range <>) of Discrete_S8;
--/ if Pack then
--// pragma Pack (Array_S16_U16_Of_S8);
--/ end if;
----------------------------------------------------------------------
-------------------------
-- Major test sections --
-------------------------
procedure Test_Discrete_Conversions is
procedure To_Raw is
new Xlbmp_Generic_Converters.Convert_Discrete_To_Raw (Discrete_S32);
procedure From_Raw is
new Xlbmp_Generic_Converters.Convert_Raw_To_Discrete (Discrete_S32);
procedure Test_Discrete_S32 is
new Tests.Tester (Discrete_S32, "Discrete_S32", To_Raw, From_Raw);
procedure To_Raw is
new Xlbmp_Generic_Converters.Convert_Discrete_To_Raw (Discrete_S16);
procedure From_Raw is
new Xlbmp_Generic_Converters.Convert_Raw_To_Discrete (Discrete_S16);
procedure Test_Discrete_S16 is
new Tests.Tester (Discrete_S16, "Discrete_S16", To_Raw, From_Raw);
procedure To_Raw is
new Xlbmp_Generic_Converters.Convert_Discrete_To_Raw (Discrete_S8);
procedure From_Raw is
new Xlbmp_Generic_Converters.Convert_Raw_To_Discrete (Discrete_S8);
procedure Test_Discrete_S8 is
new Tests.Tester (Discrete_S8, "Discrete_S8", To_Raw, From_Raw);
procedure To_Raw is
new Xlbmp_Generic_Converters.Convert_Discrete_To_Raw (Discrete_U16);
procedure From_Raw is
new Xlbmp_Generic_Converters.Convert_Raw_To_Discrete (Discrete_U16);
procedure Test_Discrete_U16 is
new Tests.Tester (Discrete_U16, "Discrete_U16", To_Raw, From_Raw);
procedure To_Raw is
new Xlbmp_Generic_Converters.Convert_Discrete_To_Raw (Discrete_U8);
procedure From_Raw is
new Xlbmp_Generic_Converters.Convert_Raw_To_Discrete (Discrete_U8);
procedure Test_Discrete_U8 is
new Tests.Tester (Discrete_U8, "Discrete_U8", To_Raw, From_Raw);
begin
Test_Io.Section ("Converting discrete types");
Test_Discrete_S32 ("16#0000_0000#", 0, (1 .. 4 => 16#00#));
Test_Discrete_S32 ("16#0000_0001#", 1, Swab_00_00_00_01);
Test_Discrete_S32 ("16#FFFF_FFFF#", -1, Swab_Ff_Ff_Ff_Ff);
Test_Discrete_S32 ("16#8000_0000#", Discrete_S32'First,
Swab_80_00_00_00);
Test_Discrete_S32 ("16#7FFF_FFFF#", Discrete_S32'Last,
Swab_7f_Ff_Ff_Ff);
Test_Discrete_S32 ("16#0123_4567#", 16#0123_4567#, Swab_01_23_45_67);
Test_Io.New_Line;
Test_Discrete_S16 ("16#0000#", 0, Swab_00_00);
Test_Discrete_S16 ("16#0001#", 1, Swab_00_01);
Test_Discrete_S16 ("16#FFFF#", -1, Swab_Ff_Ff);
Test_Discrete_S16 ("16#8000#", Discrete_S16'First, Swab_80_00);
Test_Discrete_S16 ("16#7FFF#", Discrete_S16'Last, Swab_7f_Ff);
Test_Discrete_S16 ("16#0123#", 16#0123#, Swab_01_23);
Test_Io.New_Line;
Test_Discrete_S8 ("16#00#", 0, (1 => 16#00#));
Test_Discrete_S8 ("16#01#", 1, (1 => 16#01#));
Test_Discrete_S8 ("16#FF#", -1, (1 => Raw_Ff));
Test_Discrete_S8 ("16#80#", Discrete_S8'First, (1 => Raw_80));
Test_Discrete_S8 ("16#7F#", Discrete_S8'Last, (1 => 16#7F#));
Test_Io.New_Line;
Test_Discrete_U16 ("16#0000#", 0, Swab_00_00);
Test_Discrete_U16 ("16#0001#", 1, Swab_00_01);
Test_Discrete_U16 ("16#FFFF#", Discrete_U16'Last, Swab_Ff_Ff);
Test_Discrete_U16 ("16#8000#", 16#8000#, Swab_80_00);
Test_Discrete_U16 ("16#7FFF#", 16#7FFF#, Swab_7f_Ff);
Test_Discrete_U16 ("16#0123#", 16#0123#, Swab_01_23);
Test_Io.New_Line;
Test_Discrete_U8 ("16#00#", 0, (1 => 16#00#));
Test_Discrete_U8 ("16#01#", 1, (1 => 16#01#));
Test_Discrete_U8 ("16#FF#", Discrete_U8'Last, (1 => Raw_Ff));
Test_Discrete_U8 ("16#7F#", 127, (1 => 16#7F#));
Test_Discrete_U8 ("16#80#", 128, (1 => 16#80#));
Test_Io.New_Line;
end Test_Discrete_Conversions;
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
procedure Test_Private_Conversions is
procedure To_Raw is
new Xlbmp_Generic_Converters.Convert_Private_To_Raw (Private_48);
procedure From_Raw is
new Xlbmp_Generic_Converters.Convert_Raw_To_Private (Private_48);
procedure Test_Private_48 is
new Tests.Tester (Private_48, "Private_48", To_Raw, From_Raw);
procedure To_Raw is
new Xlbmp_Generic_Converters.Convert_Private_To_Raw (Private_32);
procedure From_Raw is
new Xlbmp_Generic_Converters.Convert_Raw_To_Private (Private_32);
procedure Test_Private_32 is
new Tests.Tester (Private_32, "Private_32", To_Raw, From_Raw);
procedure To_Raw is
new Xlbmp_Generic_Converters.Convert_Private_To_Raw (Private_16);
procedure From_Raw is
new Xlbmp_Generic_Converters.Convert_Raw_To_Private (Private_16);
procedure Test_Private_16 is
new Tests.Tester (Private_16, "Private_16", To_Raw, From_Raw);
begin
Test_Io.Section ("Converting private types");
Test_Private_48 ("16#0000_0000_0000#", (0, 0, 0), (1 .. 6 => 16#00#));
Test_Private_48 ("16#0000_0000_0001#", (0, 0, 1),
Swab_00_00 & Swab_00_00 & Swab_00_01);
Test_Private_48 ("16#FFFF_FFFF_FFFF#", (-1, -1, -1),
Swab_Ff_Ff & Swab_Ff_Ff & Swab_Ff_Ff);
Test_Private_48 ("16#0123_4567_89AB#", (16#0123#, 16#4567#, -30293),
Swab_01_23 & Swab_45_67 & Swab_89_Ab);
Test_Io.New_Line;
Test_Private_32 ("16#0000_0000#", (Value => 0), Swab_00_00_00_00);
Test_Private_32 ("16#0000_0001#", (Value => 1), Swab_00_00_00_01);
Test_Private_32 ("16#FFFF_FFFF#", (Value => -1), Swab_Ff_Ff_Ff_Ff);
Test_Private_32 ("16#8000_0000#", (Value => Discrete_S32'First),
Swab_80_00_00_00);
Test_Private_32 ("16#7FFF_FFFF#", (Value => Discrete_S32'Last),
Swab_7f_Ff_Ff_Ff);
Test_Private_32 ("16#0123_4567#", (Value => 16#0123_4567#),
Swab_01_23_45_67);
Test_Io.New_Line;
Test_Private_16 ("16#0000#", (Value => 0), Swab_00_00);
Test_Private_16 ("16#0001#", (Value => 1), Swab_00_01);
Test_Private_16 ("16#FFFF#", (Value => -1), Swab_Ff_Ff);
Test_Private_16 ("16#8000#", (Value => Discrete_S16'First), Swab_80_00);
Test_Private_16 ("16#7FFF#", (Value => Discrete_S16'Last), Swab_7f_Ff);
Test_Private_16 ("16#0123#", (Value => 16#0123#), Swab_01_23);
Test_Io.New_Line;
end Test_Private_Conversions;
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
procedure Test_Array_Conversions is
procedure To_Raw is
new Xlbmp_Generic_Converters.Convert_Array_To_Raw (Discrete_U16, Discrete_S8, Array_S8_Of_U16);
procedure From_Raw is
new Xlbmp_Generic_Converters.Convert_Raw_To_Array
(Discrete_U16, Discrete_S8, Array_S8_Of_U16);
procedure Test_Array_S8_Of_U16 is
new Tests.Tester_1d (Discrete_U16, Discrete_S8, Array_S8_Of_U16,
"Array_S8_Of_U16", To_Raw, From_Raw);
procedure To_Raw is
new Xlbmp_Generic_Converters.Convert_Array_To_Raw
(Discrete_S8, Discrete_U16, Array_U16_Of_S8);
procedure From_Raw is
new Xlbmp_Generic_Converters.Convert_Raw_To_Array
(Discrete_S8, Discrete_U16, Array_U16_Of_S8);
procedure Test_Array_U16_Of_S8 is
new Tests.Tester_1d (Discrete_S8, Discrete_U16, Array_U16_Of_S8,
"Array_U16_Of_S8", To_Raw, From_Raw);
begin
Test_Io.Section ("Converting array types");
Test_Array_S8_Of_U16
("1..0 => 0", (1 .. 0 => 16#0000#), (1 .. 0 => 16#00#));
Test_Array_S8_Of_U16
("9..-4 => 0", (9 .. -4 => 16#0000#), (1 .. 0 => 16#00#));
Test_Array_S8_Of_U16
("1..1 => 16#0000#", (1 => 16#0000#), (1 .. 2 => 16#00#));
Test_Array_S8_Of_U16 ("0..0 => 16#0001#", (0 => 16#0001#), Swab_00_01);
Test_Array_S8_Of_U16 ("16#0123#, 16#4567#", (16#0123#, 16#4567#),
Swab_01_23 & Swab_45_67);
Test_Array_S8_Of_U16 ("127 => 16#FFFF#", (127 => 16#FFFF#), Swab_Ff_Ff);
Test_Array_S8_Of_U16 ("-5..-3 => 16#5555#",
(-5 .. -3 => 16#5555#), (1 .. 6 => 16#55#));
Test_Io.New_Line;
Test_Array_U16_Of_S8
("1..0 => 0", (1 .. 0 => 16#00#), (1 .. 0 => 16#00#));
Test_Array_U16_Of_S8
("9..-4 => 0", (9 .. -4 => 16#00#), (1 .. 0 => 16#00#));
Test_Array_U16_Of_S8 ("1..1 => 16#00#", (1 => 16#00#), (1 => 16#00#));
Test_Array_U16_Of_S8 ("0..0 => 16#01#", (0 => 16#01#), (1 => 16#01#));
Test_Array_U16_Of_S8 ("16#01#, 16#23#, 16#45#, 16#67#",
(16#01#, 16#23#, 16#45#, 16#67#),
(16#01#, 16#23#, 16#45#, 16#67#));
Test_Array_U16_Of_S8 ("65535 => 16#FF#", (65535 => -1), (1 => Raw_Ff));
Test_Io.New_Line;
end Test_Array_Conversions;
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
procedure Test_2d_Array_Conversions is
procedure To_Raw is
new Xlbmp_Generic_Converters.Convert_2d_Array_To_Raw
(Discrete_S8, Discrete_S16,
Discrete_U16, Array_S16_U16_Of_S8);
procedure From_Raw is
new Xlbmp_Generic_Converters.Convert_Raw_To_2d_Array
(Discrete_S8, Discrete_S16,
Discrete_U16, Array_S16_U16_Of_S8);
procedure Test_Array_S16_U16_Of_S8 is
new Tests.Tester_2d (Discrete_S8, Discrete_S16,
Discrete_U16, Array_S16_U16_Of_S8,
"Array_S16_U16_Of_S8", To_Raw, From_Raw);
begin
Test_Io.Section ("Converting 2d array types");
Test_Array_S16_U16_Of_S8
("1..0 => (1..0 => 0)",
(1 .. 0 => (1 .. 0 => 0)), (1 .. 0 => 16#00#));
Test_Array_S16_U16_Of_S8
("9..-4 => (1..1 => 0)",
(9 .. -4 => (1 .. 1 => 0)), (1 .. 0 => 16#00#));
Test_Array_S16_U16_Of_S8
("1..1 => (9..-4 => 0)",
(1 .. 1 => (9 .. -4 => 0)), (1 .. 0 => 16#00#));
Test_Array_S16_U16_Of_S8 ("1..1 => (1..1 => 16#01#)",
(1 => (1 => 16#01#)), (1 => 16#01#));
Test_Array_S16_U16_Of_S8 ("0..0 => (0..0 => 16#02#)",
(0 => (0 => 16#02#)), (1 => 16#02#));
Test_Array_S16_U16_Of_S8 ("(1, 2, 3), (4, 5, 6)",
((1, 2, 3), (4, 5, 6)), (1, 2, 3, 4, 5, 6));
Test_Array_S16_U16_Of_S8 ("127 => (255 => 16#FF#)",
(127 => (255 => -1)), (1 => Raw_Ff));
Test_Array_S16_U16_Of_S8
("-5..-3 => (0..1 => 16#80#)",
(-5 .. -3 => (0 .. 1 => -128)), (1 .. 6 => Raw_80));
Test_Io.New_Line;
end Test_2d_Array_Conversions;
begin
Test_Discrete_Conversions;
Test_Private_Conversions;
Test_Array_Conversions;
Test_2d_Array_Conversions;
end Cvt_010;
nblk1=16
nid=0
hdr6=2c
[0x00] rec0=24 rec1=00 rec2=01 rec3=002
[0x01] rec0=1d rec1=00 rec2=02 rec3=034
[0x02] rec0=24 rec1=00 rec2=03 rec3=014
[0x03] rec0=00 rec1=00 rec2=16 rec3=016
[0x04] rec0=12 rec1=00 rec2=04 rec3=03a
[0x05] rec0=00 rec1=00 rec2=15 rec3=05c
[0x06] rec0=14 rec1=00 rec2=05 rec3=05c
[0x07] rec0=01 rec1=00 rec2=14 rec3=01a
[0x08] rec0=13 rec1=00 rec2=06 rec3=006
[0x09] rec0=15 rec1=00 rec2=07 rec3=03a
[0x0a] rec0=13 rec1=00 rec2=08 rec3=038
[0x0b] rec0=01 rec1=00 rec2=13 rec3=046
[0x0c] rec0=12 rec1=00 rec2=09 rec3=018
[0x0d] rec0=14 rec1=00 rec2=0a rec3=002
[0x0e] rec0=00 rec1=00 rec2=12 rec3=01c
[0x0f] rec0=12 rec1=00 rec2=0b rec3=018
[0x10] rec0=00 rec1=00 rec2=11 rec3=04c
[0x11] rec0=14 rec1=00 rec2=0c rec3=014
[0x12] rec0=12 rec1=00 rec2=0d rec3=042
[0x13] rec0=01 rec1=00 rec2=10 rec3=022
[0x14] rec0=14 rec1=00 rec2=0e rec3=00e
[0x15] rec0=11 rec1=00 rec2=0f rec3=001
tail 0x21500a126819789ed8e5c 0x42a00088462063203