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

⟦267f38b06⟧ Ada Source

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

Derivation

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

with Xlbt_String7;  
use Xlbt_String7;  
with Xlbt_String;  
use Xlbt_String;  
with Xlbt_String16;  
use Xlbt_String16;

with Test_Io;  
use Test_Io;

with Xlbt_Arithmetic;  
use Xlbt_Arithmetic;  
with Xlbt_Rm;  
use Xlbt_Rm;

with Xlbp_Rm;  
use Xlbp_Rm;  
with Xlbp_Rm_Name;  
use Xlbp_Rm_Name;

with Xlbmp_Debugger;

procedure Rm_040 is
------------------------------------------------------------------------------
-- Tests for Xlbp_Rm - Entry assignment tests.
------------------------------------------------------------------------------
-- 07/05/90 GEB     | Created.
------------------------------------------------------------------------------

    Failed : exception;

    Replist : X_Rm_Representation_List;  
    Value1  : X_Rm_Value;  
    Value2  : X_Rm_Value;

    Rep_Boolean           : X_Rm_Representation :=  
       X_Rm_String_To_Representation ("Boolean");  
    Rep_S_Long            : X_Rm_Representation :=  
       X_Rm_String_To_Representation ("S_Long");  
    Rep_U_Long            : X_Rm_Representation :=  
       X_Rm_String_To_Representation ("U_Long");  
    Rep_String_Pointer    : X_Rm_Representation :=  
       X_Rm_String_To_Representation ("String");  
    Rep_String8_Pointer   : X_Rm_Representation :=  
       X_Rm_String_To_Representation ("String8");  
    Rep_String16_Pointer  : X_Rm_Representation :=  
       X_Rm_String_To_Representation ("String16");  
    Rep_U_Char_List       : X_Rm_Representation :=  
       X_Rm_String_To_Representation ("U_Char_Array");  
    Rep_Universal_Pointer : X_Rm_Representation :=  
       X_Rm_String_To_Representation ("Universal");

begin

----Set up for debugging.

    Xlbmp_Debugger.Register_Debugging_Imagers;

----Simple Store and Fetch operations.

    Section ("Store/Fetch X_Rm_Entry values");

----Try assigning one of every type of value to a value and see if we get
--  any errors.

----BOOLEAN

    Value1 := (Kind => Is_Boolean, V_Boolean => True);  
    Value2 := (Kind => Is_Boolean, V_Boolean => False);  
    if Value2.V_Boolean /= False then  
        raise Failed;  
    elsif Value1.V_Boolean /= True then  
        raise Failed;  
    end if;

--S_LONG

    Value1 := (Kind => Is_S_Long, V_S_Long => 1);  
    Value2 := (Kind => Is_S_Long, V_S_Long => -20);  
    if Value2.V_S_Long /= -20 then  
        raise Failed;  
    elsif Value1.V_S_Long /= 1 then  
        raise Failed;  
    end if;

--S_Long

    Value1 := (Kind => Is_S_Long, V_S_Long => 1);  
    Value2 := (Kind => Is_S_Long, V_S_Long => 20);  
    if Value2.V_S_Long /= 20 then  
        raise Failed;  
    elsif Value1.V_S_Long /= 1 then  
        raise Failed;  
    end if;

--STRING

    declare  
        Str1 : X_String7_Pointer := new String'("Abcd");  
        Str2 : X_String7_Pointer := new String'("Quadro");  
    begin  
        Value1 := (Kind => Is_X_String7_Pointer, V_X_String7_Pointer => Str1);  
        Value2 := (Kind => Is_X_String7_Pointer, V_X_String7_Pointer => Str2);  
        if Value2.V_X_String7_Pointer /= Str2 then  
            raise Failed;  
        elsif Value1.V_X_String7_Pointer /= Str1 then  
            raise Failed;  
        end if;  
    end;

--STRING8

    declare  
        Str1 : X_String_Pointer := new X_String (1 .. 10);  
        Str2 : X_String_Pointer := new X_String (20 .. 35);  
    begin  
        Value1 := (Kind => Is_X_String_Pointer, V_X_String_Pointer => Str1);  
        Value2 := (Kind => Is_X_String_Pointer, V_X_String_Pointer => Str2);  
        if Value2.V_X_String_Pointer /= Str2 then  
            raise Failed;  
        elsif Value1.V_X_String_Pointer /= Str1 then  
            raise Failed;  
        end if;  
    end;

--STRING16

    declare  
        Str1 : X_String16_Pointer := new X_String16 (1 .. 10);  
        Str2 : X_String16_Pointer := new X_String16 (20 .. 35);  
    begin  
        Value1 := (Kind => Is_X_String16_Pointer, V_X_String16_Pointer => Str1);  
        Value2 := (Kind => Is_X_String16_Pointer, V_X_String16_Pointer => Str2);  
        if Value2.V_X_String16_Pointer /= Str2 then  
            raise Failed;  
        elsif Value1.V_X_String16_Pointer /= Str1 then  
            raise Failed;  
        end if;  
    end;

--U_Char_Array

    declare  
        Str1 : U_Char_List := new U_Char_Array (1 .. 10);  
        Str2 : U_Char_List := new U_Char_Array (20 .. 35);  
    begin  
        Value1 := (Kind => Is_U_Char_List, V_U_Char_List => Str1);  
        Value2 := (Kind => Is_U_Char_List, V_U_Char_List => Str2);  
        if Value2.V_U_Char_List /= Str2 then  
            raise Failed;  
        elsif Value1.V_U_Char_List /= Str1 then  
            raise Failed;  
        end if;  
    end;

--UNIVERSAL_POINTER

    Value1 := (Kind                  => Is_X_Universal_Pointer,  
               V_X_Universal_Pointer => None_X_Rm_Universal_Pointer);  
    if Value1.V_X_Universal_Pointer /= None_X_Rm_Universal_Pointer then  
        raise Failed;  
    end if;

end Rm_040;  

    nblk1=8
    nid=0
    hdr6=10
        [0x00] rec0=27 rec1=00 rec2=01 rec3=068
        [0x01] rec0=01 rec1=00 rec2=08 rec3=02e
        [0x02] rec0=1d rec1=00 rec2=02 rec3=02c
        [0x03] rec0=00 rec1=00 rec2=07 rec3=02e
        [0x04] rec0=22 rec1=00 rec2=03 rec3=09c
        [0x05] rec0=1e rec1=00 rec2=04 rec3=004
        [0x06] rec0=1b rec1=00 rec2=05 rec3=046
        [0x07] rec0=06 rec1=00 rec2=06 rec3=000
    tail 0x21500a35e81978d1d587f 0x42a00088462063203