inform7/inform6/Tests/Test Cases/classcopytest-G.inf

Constant Story "ClassCopyTest";
Constant Headline "Not a game.^";

Release 1;

! This is a compiler unit test for how multiple-inheritance objects
! handle copy and recreate.

#ifdef TARGET_ZCODE;
Constant HDR_GAMERELEASE      = $02;     ! word
Constant HDR_GAMESERIAL       = $12;     ! six ASCII characters
#ifnot;
Global gg_mainwin;
Constant HDR_GLULXVERSION  $04;     ! long word
Constant ROM_GAMERELEASE   $34;     ! short word
Constant ROM_GAMESERIAL    $36;     ! six ASCII characters
#endif; ! TARGET_GLULX

Global failures;

[ Main loc;
    #Ifdef TARGET_GLULX;
	@setiosys 2 0;
	@push 201; @push 3; @push 0; @push 0; @push 0;
	@glk $0023 5 gg_mainwin;

	@push gg_mainwin;
	@glk $002F 1 loc;
    #Endif; ! TARGET_

	loc = 0;

	Banner();
	new_line;
	RunTest();
];

[ Banner  ix;
    if (Story ~= 0) {
        #ifdef TARGET_ZCODE;
        #ifV5; style bold; #Endif;
        print (string) Story;
        #ifV5; style roman; #Endif;
        #ifnot; ! TARGET_GLULX;
        glk($0086, 3); ! set header style
        print (string) Story;
        glk($0086, 0); ! set normal style
        #Endif; ! TARGET_
    }
    if (Headline ~= 0) print ": ", (string) Headline;
    #ifdef TARGET_ZCODE;
    print "Release ", (HDR_GAMERELEASE-->0) & $03ff, " / Serial number ";
    for (ix=0 : ix<6 : ix++) print (char) HDR_GAMESERIAL->ix;
    #ifnot; ! TARGET_GLULX;
    print "Release ";
    @aloads ROM_GAMERELEASE 0 ix;
    print ix;
    print " / Serial number ";
    for (ix=0 : ix<6 : ix++) print (char) ROM_GAMESERIAL->ix;
    #Endif; ! TARGET_
    print " / Inform v"; inversion;
    print ", compiler options ";
    ix = false;
    #ifdef STRICT_MODE;
    print "S"; ix++;
    #Endif; ! STRICT_MODE
    #ifdef INFIX;
    print "X"; ix++;
    #ifnot;
    #ifdef DEBUG;
    print "D"; ix++;
    #Endif; ! DEBUG
    #Endif; ! INFIX
    if (~~ix) print "(none)";
    new_line;

    #ifdef TARGET_GLULX;
    @gestalt 1 0 ix;
    print "Interpreter version ", ix / $10000, ".", (ix & $FF00) / $100,
    ".", ix & $FF, " / ";
    @gestalt 0 0 ix;
    print "VM ", ix / $10000, ".", (ix & $FF00) / $100, ".", ix & $FF, " / ";
    ix = HDR_GLULXVERSION-->0;
    print "game file format ", ix / $10000, ".", (ix & $FF00) / $100, ".", ix & $FF, "^";
    #ifnot;
    print "Game file format ", 0->0, ".^";
    #Endif; ! TARGET_GLULX
];

[ RunTest;
	ClassCopyTest();
	
	new_line;
	if (failures == 0)
		print "All passed.^";
	else
		print failures, " errors!^";
];

Property genprop;
Property additive addprop;
Attribute attr1;
Attribute attr2;
Attribute attr3;

class Foo(0)
  with indprop 11,
  with addprop 77,
  has attr1,
  has attr2;

class Bar
  with indprop 22,
  with genprop 33,
  has ~attr1;

Object obj1
  class Foo,
  class Bar;

Object obj2
  class Bar,
  class Foo;

Object obj3
  class Bar,
  class Foo,
  with indprop 4,
  with genprop 4,
  longprop 10 11 12,
  has ~attr1;

Object obj4
  class Foo,
  with indprop 5,
  with genprop 6,
  longprop 5 6 7 8;

Object obj5
  class Foo,
  with longprop 13 14 15;

[ ClassCopyTest;
	give obj1 ~attr1;
	give obj1 attr3;
	obj1.indprop = 12;
	
	print "obj1.indprop: "; check_value(obj1.indprop, 12); print "^";
	print "obj1.genprop: "; check_value(obj1.genprop, 33); print "^";
	print "obj1.attr1: "; check_value(obj1 has attr1, false); print "^";
	print "obj1.attr2: "; check_value(obj1 has attr2, true); print "^";
	print "obj1.attr3: "; check_value(obj1 has attr3, true); print "^";

	Foo.copy(obj2, obj1);
	
	print "obj2.indprop: "; check_value(obj2.indprop, 12); print "^";
	print "obj2.genprop: "; check_value(obj2.genprop, 33); print "^";
	print "obj2.attr1: "; check_value(obj2 has attr1, false); print "^";
	print "obj2.attr2: "; check_value(obj2 has attr2, true); print "^";
	print "obj2.attr3: "; check_value(obj2 has attr3, true); print "^";

	Foo.copy(obj2, obj3);
	
	print "obj2.indprop: "; check_value(obj2.indprop, 4); print "^";
	print "obj2.genprop: "; check_value(obj2.genprop, 4); print "^";
	print "obj2.attr1: "; check_value(obj2 has attr1, false); print "^";
	print "obj2.attr2: "; check_value(obj2 has attr2, true); print "^";
	print "obj2.attr3: "; check_value(obj2 has attr3, false); print "^";

	Foo.copy(obj3, obj4);
	
	print "obj3.indprop: "; check_value(obj3.indprop, 5); print "^";
	print "obj3.genprop: "; check_value(obj3.genprop, 6); print "^";
	print "obj3.longprop[0]: "; check_value((obj3.&longprop)-->0, 10); print "^";
	print "obj3.attr1: "; check_value(obj3 has attr1, true); print "^";
	print "obj3.attr2: "; check_value(obj3 has attr2, true); print "^";
	print "obj3.attr3: "; check_value(obj3 has attr3, false); print "^";

	obj3.genprop = 67;
	give obj3 attr3;
	Foo.recreate(obj3);
	
	print "obj3.indprop: "; check_value(obj3.indprop, 11); print "^";
	print "obj3.genprop: "; check_value(obj3.genprop, 67); print "^";
	print "obj3.longprop[0]: "; check_value((obj3.&longprop)-->0, 10); print "^";
	print "obj3.attr1: "; check_value(obj3 has attr1, true); print "^";
	print "obj3.attr2: "; check_value(obj3 has attr2, true); print "^";
	print "obj3.attr3: "; check_value(obj3 has attr3, false); print "^";

	(obj5.&longprop)-->1 = 114;
	Foo.copy(obj3, obj5);
	
	print "obj3.longprop[0]: "; check_value((obj3.&longprop)-->0, 13); print "^";
	print "obj3.longprop[1]: "; check_value((obj3.&longprop)-->1, 114); print "^";
	print "obj3.longprop[2]: "; check_value((obj3.&longprop)-->2, 15); print "^";
];

[ check_value val1 val2;
	print val1;
	if (val1 ~= val2) {
		failures++;
		print " (ERROR, should be ", val2, ")";
	}
];