|
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 - metrics - download
Length: 26624 (0x6800)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, procedure Cvt_100, seg_0054b7
└─⟦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 Xlbt_Basic;
with Xlbt_Hint;
with Xlbit_Hint3;
with Xlbt_Misc;
with Xlbt_String;
with Xlbt_String16;
with Xlbp_U_Char_Converters;
procedure Cvt_100 is
------------------------------------------------------------------------------
-- Tests for Xlbp_U_Char_Converters
--
-- Xlbip_U_Char_Converters only instantiates the converters actually used
-- by the protocol. The Tester generics expect to have symmetric
-- converters for each type. Individual tests instantiate their own
-- dummy To_Uca and From_Uca converters when necessary.
------------------------------------------------------------------------------
-- 09/25/90 DRK | Created.
------------------------------------------------------------------------------
---------------------------------
-- Handy constants and renames --
---------------------------------
package Utils renames Cvt_Test_Utilities;
package Tests renames Utils.U_Char_Tests;
package Dummy renames Utils.Dummy_Converters;
use Utils.U_Char_Constants;
----------------------------------------------------------------------
-------------------------
-- Major test sections --
-------------------------
procedure Test_X_Atom_Array is
procedure Test is new Tests.Tester_1d
(Xlbt_Basic.X_Atom, Xlbt_Arithmetic.S_Natural,
Xlbt_Basic.X_Atom_Array, "X_Atom_Array",
Xlbp_U_Char_Converters.To_Uca,
Xlbp_U_Char_Converters.From_Uca);
begin
Test_Io.Section ("X_Atom_Array conversions");
Test ("1..0 => 0", (1 .. 0 => (Number => 0)), (1 .. 0 => 0));
Test ("2..2 => -1", (2 => (Number => Minus_1)), (1 .. 4 => Uca_Ff));
Test ("0..0 => 2", (0 => (Number => 2)), Swab_00_00_00_02);
Test ("1..2 => 1", (1 .. 2 => (Number => 1)),
Swab_00_00_00_01 & Swab_00_00_00_01);
Test_Io.New_Line;
end Test_X_Atom_Array;
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
procedure Test_X_Icon_Size_Array is
procedure Test is new Tests.Tester_1d (Xlbt_Hint.X_Icon_Size,
Xlbt_Arithmetic.S_Natural,
Xlbt_Hint.X_Icon_Size_Array,
"X_Icon_Size_Array",
Xlbp_U_Char_Converters.To_Uca,
Xlbp_U_Char_Converters.From_Uca);
begin
Test_Io.Section ("X_Icon_Size_Array conversions");
Test ("1..0 => 0", (1 .. 0 => (0, 0, 0, 0, 0, 0)), (1 .. 0 => 0));
Test ("2..2 => 1.2.3.4.5.6", (2 => (1, 2, 3, 4, 5, 6)),
Swab_00_00_00_01 & Swab_00_00_00_02 & Swab_00_00_00_03 &
Swab_00_00_00_04 & Swab_00_00_00_05 & Swab_00_00_00_06);
Test ("0..0 => 1", (0 => (0, 0, 0, 0, 0, 1)),
(1 .. 20 => 0) & Swab_00_00_00_01);
Test ("1, 2", ((0, 0, 0, 0, 0, 1), (0, 0, 0, 0, 0, 2)),
(1 .. 20 => 0) & Swab_00_00_00_01 &
(1 .. 20 => 0) & Swab_00_00_00_02);
Test_Io.New_Line;
end Test_X_Icon_Size_Array;
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
procedure Test_X_Size_Hints_Protocol is
procedure Test is new Tests.Tester (Xlbit_Hint3.X_Size_Hints_Protocol,
"X_Size_Hints_Protocol",
Xlbp_U_Char_Converters.To_Uca,
Xlbp_U_Char_Converters.From_Uca);
begin
Test_Io.Section ("X_Size_Hints_Protocol conversions");
Test ("0", ((others => False), 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
(0, 0), (0, 0), 0, 0, Xlbit_Hint3.Unmap_Gravity),
(1 .. 72 => 0));
Test ("1.2.3.4.5.6.7.8.9.10.11.12.13.14.15.1",
((Xlbt_Hint.U_S_Position => True, others => False),
2, 3, 4, 5, 6, 7, 8, 9, 10, 11, (0, 12), (0, 13),
14, 15, Xlbit_Hint3.North_West_Gravity),
Swab_00_00_00_01 & Swab_00_00_00_02 & Swab_00_00_00_03 &
Swab_00_00_00_04 & Swab_00_00_00_05 & Swab_00_00_00_06 &
Swab_00_00_00_07 & Swab_00_00_00_08 & Swab_00_00_00_09 &
Swab_00_00_00_0a & Swab_00_00_00_0b &
(Swab_00_00_00_00 & Swab_00_00_00_0c) &
(Swab_00_00_00_00 & Swab_00_00_00_0d) & Swab_00_00_00_0e &
Swab_00_00_00_0f & Swab_00_00_00_01);
Test_Io.New_Line;
end Test_X_Size_Hints_Protocol;
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
procedure Test_X_Standard_Colormap is
procedure To_Uca is new Dummy.Convert_From_Private
(Xlbt_Hint.X_Standard_Colormap,
Xlbt_Arithmetic.U_Char_Array);
procedure Test is new Tests.Tester (Xlbt_Hint.X_Standard_Colormap,
"X_Standard_Colormap", To_Uca,
Xlbp_U_Char_Converters.From_Uca);
begin
Test_Io.Section ("X_Standard_Colormap conversions");
Test ("0", ((Id => (Number => 0)), 0, 0, 0, 0, 0,
0, 0, (Number => 0), (Number => 0)), (1 .. 40 => 0));
Test ("1.2.3.4.5.6.7.8.9.10", ((Id => (Number => 1)), 2, 3, 4, 5, 6,
7, 8, (Number => 9), (Number => 10)),
Swab_00_00_00_01 & Swab_00_00_00_02 & Swab_00_00_00_03 &
Swab_00_00_00_04 & Swab_00_00_00_05 & Swab_00_00_00_06 &
Swab_00_00_00_07 & Swab_00_00_00_08 &
Swab_00_00_00_09 & Swab_00_00_00_0a);
Test_Io.New_Line;
end Test_X_Standard_Colormap;
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
procedure Test_X_Standard_Colormap_Array is
procedure From_Uca is new Dummy.Convert_To_Array
(Xlbt_Hint.X_Standard_Colormap,
Xlbt_Arithmetic.S_Natural,
Xlbt_Hint.X_Standard_Colormap_Array,
Xlbt_Arithmetic.U_Char_Array);
procedure Test is new Tests.Tester_1d
(Xlbt_Hint.X_Standard_Colormap,
Xlbt_Arithmetic.S_Natural,
Xlbt_Hint.X_Standard_Colormap_Array,
"X_Standard_Colormap_Array",
Xlbp_U_Char_Converters.To_Uca, From_Uca);
begin
Test_Io.Section ("X_Standard_Colormap_Array conversions");
Test ("1..0 => 0", (1 .. 0 => Xlbt_Hint.None_X_Standard_Colormap),
(1 .. 0 => 0));
Test ("2..2 => -1", (2 =>
((Id => (Number => Minus_1)), Minus_1, Minus_1,
Minus_1, Minus_1, Minus_1, Minus_1, Minus_1,
(Number => Minus_1), (Number => Minus_1))),
(1 .. 40 => Uca_Ff));
Test ("0..0 => 1.2.3.4.5.6.7.8.9.10",
(0 => ((Id => (Number => 1)), 2, 3, 4, 5, 6,
7, 8, (Number => 9), (Number => 10))),
Swab_00_00_00_01 & Swab_00_00_00_02 & Swab_00_00_00_03 &
Swab_00_00_00_04 & Swab_00_00_00_05 & Swab_00_00_00_06 &
Swab_00_00_00_07 & Swab_00_00_00_08 &
Swab_00_00_00_09 & Swab_00_00_00_0a);
Test ("1, 2", (((Id => (Number => 0)), 0, 0, 0, 0, 0,
0, 0, (Number => 0), (Number => 1)),
((Id => (Number => 0)), 0, 0, 0, 0, 0,
0, 0, (Number => 0), (Number => 2))),
(1 .. 36 => 0) & Swab_00_00_00_01 &
(1 .. 36 => 0) & Swab_00_00_00_02);
Test_Io.New_Line;
end Test_X_Standard_Colormap_Array;
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
procedure Test_X_Window is
procedure Test is new Tests.Tester (Xlbt_Basic.X_Window, "X_Window",
Xlbp_U_Char_Converters.To_Uca,
Xlbp_U_Char_Converters.From_Uca);
begin
Test_Io.Section ("X_Window conversions");
Test ("0", (Drawable => (Id => (Number => 0))), Swab_00_00_00_00);
Test ("1", (Drawable => (Id => (Number => 1))), Swab_00_00_00_01);
Test ("-1", (Drawable => (Id => (Number => Minus_1))),
Swab_Ff_Ff_Ff_Ff);
Test_Io.New_Line;
end Test_X_Window;
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
procedure Test_X_Window_Array is
procedure To_Uca is new Dummy.Convert_From_Array
(Xlbt_Basic.X_Window,
Xlbt_Arithmetic.S_Natural,
Xlbt_Basic.X_Window_Array,
Xlbt_Arithmetic.U_Char_Array);
procedure Test is new Tests.Tester_1d (Xlbt_Basic.X_Window,
Xlbt_Arithmetic.S_Natural,
Xlbt_Basic.X_Window_Array,
"X_Window_Array", To_Uca,
Xlbp_U_Char_Converters.From_Uca);
begin
Test_Io.Section ("X_Window_Array conversions");
Test ("1..0 => 0", (1 .. 0 => (Drawable => (Id => (Number => 0)))),
(1 .. 0 => 0));
Test ("2..2 => -1", (2 => (Drawable => (Id => (Number => Minus_1)))),
(1 .. 4 => Uca_Ff));
Test ("0..0 => 1", (0 => (Drawable => (Id => (Number => 1)))),
Swab_00_00_00_01);
Test ("1, 2", ((Drawable => (Id => (Number => 1))),
(Drawable => (Id => (Number => 2)))),
Swab_00_00_00_01 & Swab_00_00_00_02);
Test_Io.New_Line;
end Test_X_Window_Array;
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
procedure Test_X_Wm_Hints is
procedure Test is new Tests.Tester (Xlbt_Hint.X_Wm_Hints, "X_Wm_Hints",
Xlbp_U_Char_Converters.To_Uca,
Xlbp_U_Char_Converters.From_Uca);
begin
Test_Io.Section ("X_Wm_Hints conversions");
Test ("0", Xlbt_Hint.None_X_Wm_Hints, (1 .. 36 => 0));
Test ("1.1.3.4.5.6.7.8.9",
((Xlbt_Hint.Input_Hint => True, others => False), Xlbt_Misc.True,
Xlbt_Hint.Iconic_State, (Drawable => (Id => (Number => 4))),
(Drawable => (Id => (Number => 5))), 6,
7, (Drawable => (Id => (Number => 8))),
(Drawable => (Id => (Number => 9)))),
Swab_00_00_00_01 & Swab_00_00_00_01 & Swab_00_00_00_03 &
Swab_00_00_00_04 & Swab_00_00_00_05 & Swab_00_00_00_06 &
Swab_00_00_00_07 & Swab_00_00_00_08 & Swab_00_00_00_09);
Test_Io.New_Line;
end Test_X_Wm_Hints;
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
procedure Test_S_Char is
procedure Test is new Tests.Tester (Xlbt_Arithmetic.S_Char, "S_Char",
Xlbp_U_Char_Converters.To_Uca,
Xlbp_U_Char_Converters.From_Uca);
begin
Test_Io.Section ("S_Char conversions");
Test ("0", 0, (1 => 0));
Test ("1", 1, (1 => 1));
Test ("-1", Minus_1, (1 => 255));
Test_Io.New_Line;
end Test_S_Char;
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
procedure Test_S_Short is
procedure Test is new Tests.Tester (Xlbt_Arithmetic.S_Short, "S_Short",
Xlbp_U_Char_Converters.To_Uca,
Xlbp_U_Char_Converters.From_Uca);
begin
Test_Io.Section ("S_Short conversions");
Test ("0", 0, Swab_00_00);
Test ("1", 1, Swab_00_01);
Test ("-1", Minus_1, Swab_Ff_Ff);
Test_Io.New_Line;
end Test_S_Short;
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
procedure Test_S_Long is
procedure Test is new Tests.Tester (Xlbt_Arithmetic.S_Long, "S_Long",
Xlbp_U_Char_Converters.To_Uca,
Xlbp_U_Char_Converters.From_Uca);
begin
Test_Io.Section ("S_Long conversions");
Test ("0", 0, Swab_00_00_00_00);
Test ("1", 1, Swab_00_00_00_01);
Test ("-1", Minus_1, Swab_Ff_Ff_Ff_Ff);
Test_Io.New_Line;
end Test_S_Long;
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
procedure Test_U_Short is
procedure Test is new Tests.Tester (Xlbt_Arithmetic.U_Short, "U_Short",
Xlbp_U_Char_Converters.To_Uca,
Xlbp_U_Char_Converters.From_Uca);
begin
Test_Io.Section ("U_Short conversions");
Test ("0", 0, Swab_00_00);
Test ("1", 1, Swab_00_01);
Test ("-1", 16#FFFF#, Swab_Ff_Ff);
Test_Io.New_Line;
end Test_U_Short;
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
procedure Test_String is
procedure Test is new Tests.Tester_1d
(Character, Positive, String, "String",
Xlbp_U_Char_Converters.To_Uca,
Xlbp_U_Char_Converters.From_Uca);
procedure Dummy_To_Uca is new Dummy.Convert_From_Array
(Character, Positive, String,
Xlbt_Arithmetic.U_Char_Array);
procedure Test_Chop is new Tests.Tester_1d
(Character, Positive, String,
"String", Dummy_To_Uca,
Xlbp_U_Char_Converters.From_Uca);
begin
Test_Io.Section ("String conversions");
Test ("1..0 => 0", (1 .. 0 => Ascii.Nul), (1 .. 0 => 0));
Test ("2..2 => 127", (2 => Ascii.Del), (1 => 127));
Test ("Abc", "Abc", (65, 98, 99));
-- Verify that high bits are chopped in Uca data.
Test_Chop ("big-chars", Ascii.Nul & Ascii.Del & '+' & Ascii.Del,
(Uca_80, 16#7F#, Uca_Ab, Uca_Ff));
Test_Io.New_Line;
end Test_String;
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
procedure Test_String_Trans is
Trans : Xlbp_U_Char_Converters.U_Character_Array := (others => '?');
procedure Trans_From_Uca (Str : out String;
Uca : Xlbt_Arithmetic.U_Char_Array) is
begin
Xlbp_U_Char_Converters.From_Uca (Str, Uca, Trans);
end Trans_From_Uca;
procedure Test is new Tests.Tester_1d
(Character, Positive, String, "String",
Xlbp_U_Char_Converters.To_Uca,
Test_String_Trans.Trans_From_Uca);
procedure Dummy_To_Uca is new Dummy.Convert_From_Array
(Character, Positive, String,
Xlbt_Arithmetic.U_Char_Array);
procedure Test_Trans is
new Tests.Tester_1d (Character, Positive, String, "String",
Dummy_To_Uca, Test_String_Trans.Trans_From_Uca);
begin
Test_Io.Section ("String translation conversions");
-- Let normal characters translate normally.
for I in Character'First .. Character'Last loop
Trans (Character'Pos (I)) := I;
end loop;
-- Test normal translations.
Test ("1..0 => 0", (1 .. 0 => Ascii.Nul), (1 .. 0 => 0));
Test ("2..2 => 127", (2 => Ascii.Del), (1 => 127));
Test ("Abc", "Abc", (65, 98, 99));
-- Verify that translation works.
Trans (Uca_80) := 'w';
Trans (16#7F#) := 'x';
Trans (Uca_Ab) := 'y';
Trans (Uca_Ff) := 'z';
Test_Trans ("big-chars", "<wxyz>",
(60, Uca_80, 16#7F#, Uca_Ab, Uca_Ff, 62));
Test_Io.New_Line;
end Test_String_Trans;
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
procedure Test_X_String is
procedure Test is new Tests.Tester_1d (Xlbt_String.X_Character,
Xlbt_Arithmetic.S_Natural,
Xlbt_String.X_String, "X_String",
Xlbp_U_Char_Converters.To_Uca,
Xlbp_U_Char_Converters.From_Uca);
use Xlbt_String;
begin
Test_Io.Section ("X_String conversions");
Test ("1..0 => 0", (1 .. 0 => Xlbt_String.Nul), (1 .. 0 => 0));
Test ("2..2 => 255", (2 => Xlbt_String.C255), (1 => Uca_Ff));
Test ("0..0 => 1", (0 => Xlbt_String.Soh), (1 => 1));
Test ("Abc", "Abc", (65, 98, 99));
Test_Io.New_Line;
end Test_X_String;
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
procedure Test_X_String16 is
procedure Test is new Tests.Tester_1d
(Xlbt_String16.X_Character16,
Xlbt_Arithmetic.S_Natural,
Xlbt_String16.X_String16, "X_String16",
Xlbp_U_Char_Converters.To_Uca,
Xlbp_U_Char_Converters.From_Uca);
-- The protocol says a STRING16 is a list of CHAR2B's, and
-- stipulates that CHAR2Bs are NOT byte-swapped. They are
-- always sent Most-Significant-Byte first.
begin
Test_Io.Section ("X_String16 conversions");
Test ("1..0 => 0", (1 .. 0 => (0, 0)), (1 .. 0 => 0));
Test ("2..2 => -1", (2 => (255, 255)), (Uca_Ff, Uca_Ff));
Test ("0..0 => 1", (0 => (0, 1)), (0, 1));
Test ("1.2, 3.4, 5.6", ((1, 2), (3, 4), (5, 6)), (1, 2, 3, 4, 5, 6));
Test_Io.New_Line;
end Test_X_String16;
begin
Test_X_Atom_Array;
Test_X_Icon_Size_Array;
Test_X_Size_Hints_Protocol;
Test_X_Standard_Colormap;
Test_X_Standard_Colormap_Array;
Test_X_Window;
Test_X_Window_Array;
Test_X_Wm_Hints;
Test_S_Char;
Test_S_Short;
Test_S_Long;
Test_U_Short;
Test_String;
Test_String_Trans;
Test_X_String;
Test_X_String16;
end Cvt_100;
nblk1=19
nid=0
hdr6=32
[0x00] rec0=20 rec1=00 rec2=01 rec3=040
[0x01] rec0=15 rec1=00 rec2=02 rec3=076
[0x02] rec0=13 rec1=00 rec2=03 rec3=012
[0x03] rec0=12 rec1=00 rec2=04 rec3=070
[0x04] rec0=12 rec1=00 rec2=05 rec3=00a
[0x05] rec0=0f rec1=00 rec2=06 rec3=080
[0x06] rec0=00 rec1=00 rec2=19 rec3=00c
[0x07] rec0=12 rec1=00 rec2=07 rec3=080
[0x08] rec0=10 rec1=00 rec2=18 rec3=090
[0x09] rec0=01 rec1=00 rec2=08 rec3=024
[0x0a] rec0=13 rec1=00 rec2=09 rec3=056
[0x0b] rec0=12 rec1=00 rec2=0a rec3=080
[0x0c] rec0=14 rec1=00 rec2=0b rec3=060
[0x0d] rec0=13 rec1=00 rec2=0c rec3=024
[0x0e] rec0=16 rec1=00 rec2=0d rec3=01a
[0x0f] rec0=17 rec1=00 rec2=0e rec3=03c
[0x10] rec0=15 rec1=00 rec2=0f rec3=072
[0x11] rec0=16 rec1=00 rec2=17 rec3=018
[0x12] rec0=01 rec1=00 rec2=10 rec3=00c
[0x13] rec0=13 rec1=00 rec2=11 rec3=054
[0x14] rec0=00 rec1=00 rec2=16 rec3=004
[0x15] rec0=18 rec1=00 rec2=12 rec3=06e
[0x16] rec0=14 rec1=00 rec2=13 rec3=052
[0x17] rec0=1c rec1=00 rec2=14 rec3=004
[0x18] rec0=03 rec1=00 rec2=15 rec3=001
tail 0x21500a17681978a64cede 0x42a00088462063203