-- SchemaTest.mesa
-- Last edited by:
--   John Maxwell on May 14, 1982 10:11 am
--   Rick Cattell on May 22, 1982 7:11 pm
-- DBView problems:
--		No DestroySubType (in TestSubType)
--		No DestroyAttribute (in TestAttribute)
--		GetEntityByName[DomainDomain, "DomainDomain"] => NotFound
--		Renaming doesn't work
--		KeyPart not implemented
-- this program does not test:
--		nameType in DeclareDomain
-- 	version parameter in DeclareX[ . . . version: Version]
--		RecordType
--		enforcement of uniqueness on Attributes and Properties
--		runtime type-checking on Attributes and Properties
--		length properties on Attributes and Properties
--		DeclarePropertyFromAttrs
--		Anything to do with Relships or Entities
--		Transactions with the Database (open, close, mark . . .)

DIRECTORY
  DBView,
  IOStream,
  Process USING [Detach],
  Rope USING [Equal, ROPE];
  
SchemaTest: PROGRAM
  IMPORTS DBView, IOStream, Process, Rope =
  
  BEGIN
  OPEN DBView;
  
  ROPE: TYPE = Rope.ROPE;
  
  tty: IOStream.Handle← IOStream.CreateTTYStreams["SchemaTest.log"].out;

  
  TestAll: PROCEDURE =
    BEGIN
    Thing: Domain;
    Animal: Domain;
    Person: Domain;
    legalName: Property;
    ssNumber: Property;
    alive, any, father: Property;
    friend: Relation;
    of, is, for: Attribute;
    closeness, oppositeSex: Attribute;
    tty.PutF["Opening [Local]Test...\n"];
    []← OpenDatabase[databaseName: "[Local]Test", version: NewOnly];
    Thing ← TestDomain["Thing"];
    Animal ← TestDomain["Animal"];
    TestSubType[Animal, Thing];
    Person ← TestDomain["Person"];
    TestSubType[Person, Animal];
    -- test properties
    tty.PutF["Testing properties...\n"];
    any ← TestProperty["anything", Person, AnyDomainType, None];
    father ← TestProperty["father", Person, Person, Key];
    legalName ← TestProperty["legalName", Person, StringType, Key];
    ssNumber ← TestProperty["ssNumber", Person, IntType, OptionalKey];
    alive ← TestProperty["alive", Person, BoolType, None];
    -- test attributes
    tty.PutF["Testing relations...\n"];
    friend ← TestRelation["friend"]; 
    tty.PutF["Testing attributes...\n"];
    is ← TestAttribute[friend, "is", AnyDomainType, None];
    of ← TestAttribute[friend, "of", Person, Key];
    closeness ← TestAttribute[friend, "closeness", StringType, Key];
    for ← TestAttribute[friend, "for", IntType, OptionalKey];
    oppositeSex ← TestAttribute[friend, "oppositeSex", BoolType, None];
    tty.PutF["Testing domains...\n"];
    TestDataTypeDomain[];
    tty.PutF["Testing domain domain...\n"];
    TestDomainDomain[];
    tty.PutF["Closing database...\n"];
    CloseDatabase[];
    END;
    
  TestDomainDomain: PROCEDURE =
    BEGIN -- no guarantees that this is correct
    IF DomainOf[DomainDomain] # DomainDomain THEN ERROR;
    IF DomainOf[RelationDomain] # DomainDomain THEN ERROR;
    IF DomainOf[AttributeDomain] # DomainDomain THEN ERROR;
    IF DomainOf[DataTypeDomain] # DomainDomain THEN ERROR;
    TestGet[DomainDomain, DomainDomain, "Domain"];
    TestGet[DomainDomain, RelationDomain, "Relation"];
    TestGet[DomainDomain, AttributeDomain, "Attribute"];
    TestGet[DomainDomain, DataTypeDomain, "DataType"];
    END;
  
  TestDataTypeDomain: PROCEDURE =
    BEGIN -- no guarantees that this is correct
    IF DomainOf[StringType] # DataTypeDomain THEN ERROR;
    IF DomainOf[IntType] # DataTypeDomain THEN ERROR;
    IF DomainOf[BoolType] # DataTypeDomain THEN ERROR;
    IF DomainOf[RecordType] # DataTypeDomain THEN ERROR;
    IF DomainOf[AnyDomainType] # DataTypeDomain THEN ERROR;
    TestGet[DataTypeDomain, StringType, "StringType"];
    TestGet[DataTypeDomain, IntType, "IntType"];
    TestGet[DataTypeDomain, BoolType, "BoolType"];
    END;
    
  TestDomain: PROCEDURE[name: ROPE] RETURNS[d: Domain] = 
    BEGIN -- tests declaring, destroying, and renaming
    d ← DeclareDomain[name];
    TestGet[DomainDomain, d, name];
    DestroyDomain[d];
    TestNotFound[DomainDomain, d, name];
    d ← DeclareDomain[name];
    TestGet[DomainDomain, d, name];
    TestRename[DomainDomain, d, name];
    END;
    
  TestSubType: PROCEDURE[sub, super: Domain] =
    BEGIN
    DeclareSubType[of: super, is: sub];
    IF ~SubType[sub, super] THEN ERROR;
    IF SubType[super, sub] THEN ERROR;
    DestroySubType[of: super, is: sub];
    IF SubType[sub, super] THEN ERROR;
    DeclareSubType[of: super, is: sub];
    IF ~SubType[sub, super] THEN ERROR;
    IF SubType[super, sub] THEN ERROR;
    END;
    
  TestRelation: PROCEDURE[name: ROPE] RETURNS[r: Relation] = 
    BEGIN -- tests declaring, destroying, and renaming
    r ← DeclareRelation[name];
    TestGet[RelationDomain, r, name];
    DestroyRelation[r];
    TestNotFound[RelationDomain, r, name];
    r ← DeclareRelation[name];
    TestRename[RelationDomain, r, name];
    END;
    
  TestAttribute: PROCEDURE[r: Relation, name: ROPE, type: DataType, uniqueness: Uniqueness] 
      RETURNS[a: Attribute] =
    BEGIN
    a ← DeclareAttribute[r, name, type, uniqueness];
    TestGetAttribute[r, a];
    IF ~Eq[V2E[GetP[a, aRelationProp]], r] THEN ERROR;
    IF ~Eq[V2E[GetP[a, aTypeProp]], type] THEN ERROR;
    IF V2U[GetP[a, aUniquenessProp]] # uniqueness THEN ERROR;
    -- DestroyAttribute[a];
    -- TestNotFound[AttributeDomain, a, name];
    -- a ← DeclareAttribute[r, name, type, uniqueness];
    -- TestGet[AttributeDomain, a, name];
    -- TestRename[AttributeDomain, a, name];
    END;
  
  TestProperty: PROCEDURE[name: ROPE, of: Domain, is: DataType, u: Uniqueness] 
     RETURNS[p: Property] =
    BEGIN
    r: Relation;
    a: Attribute;
    key: Uniqueness ← Key;
    attributes: AttributeList;
    p ← DeclareProperty[name, of, is, u];
    r ← GetEntityByName[RelationDomain, name];
    attributes ← AttributesOf[r];
    FOR list: AttributeList ← attributes, list.rest WHILE list # NIL DO
       a ← list.first;
       SELECT TRUE FROM
          Rope.Equal[GetName[a], "of"] => {
             IF ~Eq[V2E[GetP[a, aRelationProp]], r] THEN ERROR;
             IF ~Eq[V2E[GetP[a, aTypeProp]], of] THEN ERROR;
             IF V2U[GetP[a, aUniquenessProp]] # key THEN ERROR};
          Rope.Equal[GetName[a], "is"]  => {
             IF ~Eq[V2E[GetP[a, aRelationProp]], r] THEN ERROR;
             IF ~Eq[V2E[GetP[a, aTypeProp]], is] THEN ERROR;
             IF V2U[GetP[a, aUniquenessProp]] # u THEN ERROR};
          ENDCASE => ERROR;
       ENDLOOP;
    END;
 
 SubType: PROCEDURE[sub, super: Domain] RETURNS[BOOLEAN] =
    BEGIN
    rs: RelshipSet;
    subRS: Relship;
    IF Eq[sub, super] THEN RETURN[TRUE];
    rs ← RelationSubset[SubTypeRelation, LIST[[sSubType, sub]]];
    WHILE (subRS ← NextRelship[rs]) # NIL DO
       IF SubType[super, V2E[GetF[subRS, sSuperType]]] THEN RETURN[TRUE];
       ENDLOOP;
    ReleaseRelshipSet[rs];
    RETURN[FALSE];
    END; 
         
  TestRename: PROCEDURE[d: Domain, e: Entity, name: ROPE] =
    BEGIN
    SetName[e, "Any"];
    TestGet[d, e, "Any"];
    TestNotFound[d, NIL, name];
    SetName[e, name];
    TestGet[d, e, name];
    TestNotFound[d, NIL, "Any"];
    END;
    
  TestGet: PROCEDURE[d: Domain, e: Entity, name: ROPE] =
    BEGIN
    temp: Entity;
    temp ← GetEntityByName[d, name];
    IF ~Eq[temp, e] THEN ERROR;
    IF ~Rope.Equal[GetName[e], name] THEN ERROR;
    END;
  
  TestGetAttribute: PROCEDURE[r: Relation, a: Attribute] =
    BEGIN
    attributes: AttributeList;
    attributes ← AttributesOf[r];
    FOR list: AttributeList ← attributes, list.rest WHILE list # NIL DO
       IF ~Eq[list.first, a] THEN LOOP;
       RETURN; ENDLOOP;
    ERROR;
    END;
 
  TestNotFound: PROCEDURE[d: Domain, e: Entity, name: ROPE] =
    BEGIN
    temp: Entity;
    signal: BOOLEAN ← FALSE;
    temp ← GetEntityByName[d, name ! NotFound => {signal ← TRUE; CONTINUE}];
    IF ~signal THEN ERROR;
    IF e # NIL AND ~Null[e] THEN ERROR;
    END;
 
 AttributesOf: PROC[r: Relation] RETURNS[AttributeList] =
  {RETURN[EntitySetToList[DomainSubset[AttributeDomain, LIST[[aRelationProp, r]]]]]};

 
  Process.Detach[FORK TestAll[]];
  
  END.