DataMuseum.dk Presents historical artifacts from the history of: Rational R1000/400

This is an automatic "excavation" of a thematic subset of artifacts from Datamuseum.dk's BitArchive. See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software.

top - download

⟦4f624e25d⟧ Ada Source

    Length: 9216 (0x2400)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, procedure Test, seg_02b888

Derivation

└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
    └─ ⟦5a81ac88f⟧ »Space Info Vol 1« 
        └─⟦this⟧ 

with Frame;
with Text_Io;
use Text_Io;
with Unchecked_Conversion;
procedure Test is

    Error : exception;

    type Byte is range 0 .. 255;
    for Byte'Size use 8;

    procedure Test_Command is
        function As_Byte is new Unchecked_Conversion (Frame.Command, Byte);
        R : Byte := 0;
    begin
        Put_Line ("Checking command values");
        for I in Frame.Reset .. Frame.Int_Negative loop
            if As_Byte (I) /= R then
                raise Error;
            end if;
            R := R + 1;
        end loop;
        if Frame."/=" (Frame.Command'Last, Frame.Int_Negative) or
           As_Byte (Frame.Command'Last) /= 7 then
            raise Error;
        end if;
    end Test_Command;

    procedure Test_Request is
        function As_Byte is new Unchecked_Conversion (Frame.Request, Byte);
        R : Frame.Request;
        use Frame;
    begin
        Put_Line ("Checking requests creation");
        R := Create_Request (Reset, Port_A_Numeric, 0);
        if 0 /= As_Byte (R) then
            raise Error;
        end if;
        R := Create_Request (Autotest, Port_A_Numeric, 0);
        if 32 /= As_Byte (R) then
            raise Error;
        end if;
        R := Create_Request (Autotest, Port_A_Analogic, 0);
        if 40 /= As_Byte (R) then
            raise Error;
        end if;
        R := Create_Request (Autotest, Port_A_Analogic, 1);
        if 41 /= As_Byte (R) then
            raise Error;
        end if;
        R := Create_Request (Int_Positive, Port_A_Analogic, 1);
        if 201 /= As_Byte (R) then
            raise Error;
        end if;
        R := Create_Request (Int_Positive, Port_B_Numeric, 1);
        if 209 /= As_Byte (R) then
            raise Error;
        end if;
        R := Create_Request (Int_Positive, Port_B_Numeric, 7);
        if 215 /= As_Byte (R) then
            raise Error;
        end if;
        R := Create_Request (Int_Positive, Bit1_Bit0_B_Slice);
        if 216 /= As_Byte (R) then
            raise Error;
        end if;
        R := Create_Request (Int_Positive, Bit3_Bit2_B_Slice);
        if 217 /= As_Byte (R) then
            raise Error;
        end if;
        R := Create_Request (Int_Positive, Bit5_Bit4_B_Slice);
        if 218 /= As_Byte (R) then
            raise Error;
        end if;
        R := Create_Request (Int_Positive, Bit7_Bit6_B_Slice);
        if 219 /= As_Byte (R) then
            raise Error;
        end if;
        R := Create_Request (Int_Positive, Bit3_Bit0_B_Slice);
        if 220 /= As_Byte (R) then
            raise Error;
        end if;
        R := Create_Request (Int_Positive, Bit7_Bit4_B_Slice);
        if 221 /= As_Byte (R) then
            raise Error;
        end if;
        R := Create_Request (Int_Positive, Bit7_Bit0_B_Slice);
        if 222 /= As_Byte (R) then
            raise Error;
        end if;
        R := Create_Request (Int_Positive, Bit7_Bit0_A_Slice);
        if 223 /= As_Byte (R) then
            raise Error;
        end if;
    end Test_Request;

    procedure Test_Sample_Count is
        function As_Byte is new Unchecked_Conversion (Frame.Sample_Count, Byte);
        R : Byte := 0;
        use Frame;
    begin
        Put_Line ("Checking number of samples values");
        for I in Frame.N_1 .. Frame.N_128 loop
            if As_Byte (I) /= R then
                raise Error;
            end if;
            R := R + 1;
        end loop;
        if Frame.Sample_Count'Last /= Frame.N_128 or
           As_Byte (Frame.N_128) /= 7 then
            raise Error;
        end if;
    end Test_Sample_Count;

    procedure Test_Measure is
        function As_Byte is new Unchecked_Conversion (Frame.Measure, Byte);
        R : Byte := 0;
        use Frame;
    begin
        Put_Line ("Checking measure values");
        for I in Frame.Analogic .. Frame.Detection_Down loop
            if As_Byte (I) /= R then
                raise Error;
            end if;
            R := R + 1;
        end loop;
        if Frame.Measure'Last /= Frame.Detection_Down or
           As_Byte (Frame.Detection_Down) /= 7 then
            raise Error;
        end if;
    end Test_Measure;

    procedure Test_Task is  
        function As_Byte is new Unchecked_Conversion
                                   (Frame.Task_Selection, Byte);
        R : Byte := 0;  
        T : Frame.Task_Selection;
        use Frame;
    begin
        Put_Line ("Checking task selection size");  
        if T'Size /= 8 then
            raise Error;
        end if;
        Put_Line ("Checking task selection format");  
        T := Create_Task_Selection;
        if As_Byte (T) /= 0 then
            raise Error;
        end if;
        Action_On_Task (T, 0);
        if As_Byte (T) /= 1 then
            raise Error;
        end if;
        Action_On_Task (T, 4);
        if As_Byte (T) /= 17 then
            raise Error;
        end if;
        Action_On_Task (T, 7);
        if As_Byte (T) /= 145 then
            raise Error;
        end if;
        No_Action_On_Task (T, 0);
        if As_Byte (T) /= 144 then
            raise Error;
        end if;
        No_Action_On_Task (T, 1);
        if As_Byte (T) /= 144 then
            raise Error;
        end if;
        No_Action_On_Task (T, 4);
        if As_Byte (T) /= 128 then
            raise Error;
        end if;
    end Test_Task;

begin
    Test_Command;
    Test_Request;
    Test_Sample_Count;
    Test_Measure;
    Test_Task;

    Put_Line ("Test succeeded");

exception
    when Error =>
        Put_Line ("Test failed");
    when others =>
        raise;
end Test;

    nblk1=8
    nid=6
    hdr6=c
        [0x00] rec0=24 rec1=00 rec2=01 rec3=024
        [0x01] rec0=1c rec1=00 rec2=02 rec3=036
        [0x02] rec0=1c rec1=00 rec2=03 rec3=01e
        [0x03] rec0=1e rec1=00 rec2=04 rec3=054
        [0x04] rec0=20 rec1=00 rec2=07 rec3=00c
        [0x05] rec0=25 rec1=00 rec2=05 rec3=000
        [0x06] rec0=80 rec1=80 rec2=80 rec3=404
        [0x07] rec0=04 rec1=04 rec2=04 rec3=020
    tail 0x21523dd7483ef7398ff31 0x42a00088462060003
Free Block Chain:
  0x6: 0000  00 08 00 0c 80 06 20 54 65 73 74 3b 06 00 00 00  ┆       Test;    ┆
  0x8: 0000  00 00 00 0b 00 08 20 20 20 20 20 20 20 20 08 00  ┆                ┆