inform7/inform6/Tests/Test Cases/forwardproptest_ns.inf

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

Release 1;

! This is a compiler unit test for forward declarations of properties.

#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;
    #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 0;
    #endif; ! TARGET_GLULX

	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, "^";
    #Endif; ! TARGET_GLULX
];

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

Property common1 1;

Object dummy1 with indiv1;

[ getanyprop o p;
	return o.p;
];

[ getcommon1 o;
	return o.common1;
];

[ getcommon2 o;
	return o.common2;
];

[ getindiv1 o;
	return o.indiv1;
];

[ getindiv2 o;
	return o.indiv2;
];

[ setanyprop o p v;
	o.p = v;
];

[ setcommon1 o v;
	o.common1 = v;
];

[ setcommon2 o v;
	o.common2 = v;
];

[ setindiv1 o v;
	o.indiv1 = v;
];

[ setindiv2 o v;
	o.indiv2 = v;
];

[ incanyprop o p;
	o.p++;
];

[ inccommon1 o;
	o.common1++;
];

[ inccommon2 o;
	o.common2++;
];

[ incindiv1 o;
	o.indiv1++;
];

[ incindiv2 o;
	o.indiv2++;
];

[ RunTest val;
	val = getanyprop(blank, common1);
	print "blank.common1: "; check_value(val, 1); new_line;
	val = getanyprop(blank, common2);
	print "blank.common2: "; check_value(val, 2); new_line;

	val = getanyprop(obj, common1);
	print "obj.common1: "; check_value(val, 0); new_line;
	val = getanyprop(obj, common2);
	print "obj.common2: "; check_value(val, 0); new_line;

	setanyprop(obj, common1, 11);
	setanyprop(obj, common2, 22);

	val = getanyprop(obj, common1);
	print "obj.common1: "; check_value(val, 11); new_line;
	val = getanyprop(obj, common2);
	print "obj.common2: "; check_value(val, 22); new_line;

	setcommon1(obj, 12);
	setcommon2(obj, 23);

	val = getcommon1(obj);
	print "obj.common1: "; check_value(val, 12); new_line;
	val = getcommon2(obj);
	print "obj.common2: "; check_value(val, 23); new_line;

	inccommon1(obj);
	incanyprop(obj, common1);
	incanyprop(obj, common1);
	inccommon2(obj);
	incanyprop(obj, common2);

	val = getcommon1(obj);
	print "obj.common1: "; check_value(val, 15); new_line;
	val = getcommon2(obj);
	print "obj.common2: "; check_value(val, 25); new_line;

	new_line;

	val = getanyprop(obj, indiv1);
	print "obj.indiv1: "; check_value(val, 5); new_line;
	val = getanyprop(obj, indiv2);
	print "obj.indiv2: "; check_value(val, 6); new_line;

	val = getindiv1(obj);
	print "obj.indiv1: "; check_value(val, 5); new_line;
	val = getindiv2(obj);
	print "obj.indiv2: "; check_value(val, 6); new_line;

	setanyprop(obj, indiv1, 15);
	setanyprop(obj, indiv2, 16);

	val = getanyprop(obj, indiv1);
	print "obj.indiv1: "; check_value(val, 15); new_line;
	val = getanyprop(obj, indiv2);
	print "obj.indiv2: "; check_value(val, 16); new_line;

	setindiv1(obj, 25);
	setindiv2(obj, 26);

	val = getanyprop(obj, indiv1);
	print "obj.indiv1: "; check_value(val, 25); new_line;
	val = getanyprop(obj, indiv2);
	print "obj.indiv2: "; check_value(val, 26); new_line;

	incindiv1(obj);
	incanyprop(obj, indiv1);
	incindiv2(obj);
	incanyprop(obj, indiv2);
	incanyprop(obj, indiv2);
	
	val = getanyprop(obj, indiv1);
	print "obj.indiv1: "; check_value(val, 27); new_line;
	val = getanyprop(obj, indiv2);
	print "obj.indiv2: "; check_value(val, 29); new_line;

	val = getindiv1(obj);
	print "obj.indiv1: "; check_value(val, 27); new_line;
	val = getindiv2(obj);
	print "obj.indiv2: "; check_value(val, 29); new_line;


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


Property common2 2;

Object dummy2 with indiv2;

Object blank;

Object obj
  with indiv1 5,
  with indiv2 6,
  with common1,
  with common2;