DataMuseum.dk

top - download

    Length: 6008 (0x1778)
    Types: TextFile
    Names: »B«

└─⟦f64eaa120⟧ Bits:30000752 8mm tape, Rational 1000, !projects 93 02 16
    └─ ⟦6f12a12be⟧ »DATA« 
        └─⟦this⟧ 

TextFile

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");
        if R'Size /= 8 then
            raise Error;
        end if;
        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);
        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;  
        Put_Line ("Checking task selection positions");
        T := Create_Task_Selection;
        for R in Frame.Task_Identification (0) ..
                    Frame.Task_Identification (7) loop
            Action_On_Task (T, R);
            if As_Byte (T) /= 2 ** Natural (R) then
                raise Error;
            end if;
            No_Action_On_Task (T, R);
        end loop;
    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;