[m-rev.] diff: test io__write_binary

Fergus Henderson fjh at cs.mu.OZ.AU
Thu Jan 22 15:33:04 AEDT 2004


Branches: main
Estimated hours taken: 1

tests/hard_coded/Mmakefile:
tests/hard_coded/write_binary.m:
tests/hard_coded/write_binary.exp:
	Add a test of io__write_binary/io__read_binary.

Workspace: /home/ceres/fjh/mercury
Index: tests/hard_coded/write_binary.exp
===================================================================
RCS file: tests/hard_coded/write_binary.exp
diff -N tests/hard_coded/write_binary.exp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/write_binary.exp	22 Jan 2004 04:30:44 -0000
@@ -0,0 +1,151 @@
+TESTING TERMS WITH OPERATORS
+ok... test passed:
+var("X") + int(3) * var("X^2") ; (type)
+var("X") + int(3) * var("X^2") ; (type)
+ok... test passed:
+{ type }
+{ type }
+ok... test passed:
+{ ':-' }
+{ ':-' }
+ok... test passed:
+':-'
+':-'
+ok... test passed:
+{ blah }
+{ blah }
+ok... test passed:
+blah ; (type), (type) * blah ; (type)
+blah ; (type), (type) * blah ; (type)
+ok... test passed:
+((blah ; blah), blah) * blah ; blah
+((blah ; blah), blah) * blah ; blah
+ok... test passed:
+(type) * blah ; (type)
+(type) * blah ; (type)
+TESTING DISCRIMINATED UNIONS
+ok... test passed:
+one
+one
+ok... test passed:
+two
+two
+ok... test passed:
+three
+three
+ok... test passed:
+apple([9, 5, 1])
+apple([9, 5, 1])
+ok... test passed:
+banana([three, one, two])
+banana([three, one, two])
+ok... test passed:
+zop(3.30000000000000, 2.03000000000000)
+zop(3.30000000000000, 2.03000000000000)
+ok... test passed:
+zip(3, 2)
+zip(3, 2)
+ok... test passed:
+zap(3, -2.11100000000000)
+zap(3, -2.11100000000000)
+ok... test passed:
+wombat
+wombat
+ok... test passed:
+foo
+foo
+TESTING POLYMORPHISM
+ok... test passed:
+poly_one([2399.30000000000])
+poly_one([2399.30000000000])
+ok... test passed:
+poly_two(3)
+poly_two(3)
+ok... test passed:
+poly_three(3.33000000000000, 4, poly_one(9.11000000000000))
+poly_three(3.33000000000000, 4, poly_one(9.11000000000000))
+TESTING BUILTINS
+ok... test passed:
+
+
+ok... test passed:
+Hello, world
+
+Hello, world
+
+ok... test passed:
+Foo%sFoo
+Foo%sFoo
+ok... test passed:
+"
+"
+ok... test passed:
+a
+a
+ok... test passed:
+&
+&
+ok... test passed:
+.
+.
+ok... test passed:
+%
+%
+ok... test passed:
+ 
+ 
+ok... test passed:
+	
+	
+ok... test passed:
+
+
+
+
+ok... test passed:
+\
+\
+ok... test passed:
+*
+*
+ok... test passed:
+/
+/
+ok... test passed:
+3.14159000000000
+3.14159000000000
+ok... test passed:
+1.12832498300000e-21
+1.12832498300000e-21
+ok... test passed:
+2.23954899000000e+23
+2.23954899000000e+23
+ok... test passed:
+-65
+-65
+ok... test passed:
+4
+4
+next text is expected to fail:
+test failed:
+exception(univ_cons("error reading term back in again"))
+'<<predicate>>'
+TESTING OTHER TYPES
+ok... test passed:
+var(1)
+var(1)
+ok... test passed:
+var_supply(0)
+var_supply(0)
+ok... test passed:
+var_supply(1)
+var_supply(1)
+ok... test passed:
+empty
+empty
+ok... test passed:
+qwerty(4)
+qwerty(4)
+ok... test passed:
+array([1, 2, 3, 4])
+array([1, 2, 3, 4])
Index: tests/hard_coded/write_binary.m
===================================================================
RCS file: tests/hard_coded/write_binary.m
diff -N tests/hard_coded/write_binary.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/write_binary.m	22 Jan 2004 04:30:32 -0000
@@ -0,0 +1,209 @@
+% Test case for io__write_binary/io__read_binary.
+% (adapted from tests/hard_coded/write.m, which tests io__write).
+
+% XXX currently we do not pass the test of "univ"!
+
+% XXX currently we do not pass the "B43" test,
+% because of a bug in io__read_binary
+
+:- module write_binary.
+:- interface.
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is cc_multi.
+
+:- implementation.
+
+:- import_module char, list, int, std_util, term, map, array, exception.
+
+:- pred test_ops(io__state::di, io__state::uo) is cc_multi.
+:- pred test_builtins(io__state::di, io__state::uo) is cc_multi.
+:- pred test_discriminated(io__state::di, io__state::uo) is cc_multi.
+:- pred test_polymorphism(io__state::di, io__state::uo) is cc_multi.
+:- pred test_other(io__state::di, io__state::uo) is cc_multi.
+:- pred do_test(T::in, io__state::di, io__state::uo) is cc_multi.
+:- pred do_test_2(T::in, T::out, io__state::di, io__state::uo) is det.
+
+
+:- type enum	--->	one	;	two	;	three.
+
+:- type fruit	--->	apple(list(int))
+		;	banana(list(enum)).
+
+:- type thingie	--->	foo ; bar(int) ; bar(int, int) ; qux(int) ;
+			quux(int) ; quuux(int, int) ; wombat ; 
+			zoom(int) ; zap(int, float) ; zip(int, int) ;
+			zop(float, float).
+
+:- type poly(A, B)	--->	poly_one(A) ; poly_two(B) ; 
+				poly_three(B, A, poly(B, A)).
+
+:- type no_tag		---> 	qwerty(int).
+
+:- type expr		--->	var(string)
+			;	int(int)
+			;	expr + expr
+			;	expr - expr
+			; 	expr * expr
+			;	(expr, expr)
+			;	{expr; expr}
+			;	{{expr}}
+			;	(type)
+			;	blah
+			;	(:-)
+			.
+
+main -->
+	test_ops,
+	test_discriminated,
+	test_polymorphism,
+	test_builtins, 
+	test_other.
+
+
+test_ops -->
+	io__write_string("TESTING TERMS WITH OPERATORS\n"),
+	do_test(var("X") + int(3) * var("X^2") ; (type)),
+	do_test(write_binary:{type}),
+	do_test(write_binary:{:-}),
+	do_test((:-)),
+	do_test(write_binary:{blah}),
+	do_test((blah ; (type), (type) * blah ; (type))),
+	do_test(((blah ; blah), blah) * blah ; blah),
+	do_test((type) * blah ; (type)).
+
+test_discriminated -->
+	io__write_string("TESTING DISCRIMINATED UNIONS\n"),
+
+		% test enumerations
+	do_test(one),
+	do_test(two),
+	do_test(three),
+
+		% test simple tags
+	do_test(apple([9,5,1])),
+	do_test(banana([three, one, two])),
+
+		% test complicated tags
+	do_test(zop(3.3, 2.03)),
+	do_test(zip(3, 2)),
+	do_test(zap(3, -2.111)),
+
+		% test complicated constant
+	do_test(wombat),
+	do_test(foo).
+
+test_polymorphism -->
+	io__write_string("TESTING POLYMORPHISM\n"),
+	do_test(poly_one([2399.3])),
+	do_test(poly_two(3)),
+	do_test(poly_three(3.33, 4, poly_one(9.11))).
+
+
+test_builtins -->
+	io__write_string("TESTING BUILTINS\n"),
+
+		% test strings
+ 	do_test(""),
+ 	do_test("Hello, world\n"),
+ 	do_test("Foo%sFoo"),
+ 	do_test(""""),
+
+		% test characters
+	do_test('a' `with_type` char),
+	do_test('&' `with_type` char),
+	do_test('.' `with_type` char),
+	do_test('%' `with_type` char),
+	do_test(' ' `with_type` char),
+	do_test('\t' `with_type` char),
+	do_test('\n' `with_type` char),
+	do_test(('\\') `with_type` char),
+	do_test('*' `with_type` char),
+	do_test('/' `with_type` char),
+
+		% test floats
+	do_test(3.14159),
+	do_test(11.28324983E-22),
+	do_test(22.3954899E22),
+
+		% test integers
+	do_test(-65),
+	do_test(4),
+
+%%% XXX currently we do not pass this test!
+%%%		% test univ.
+%%%	{ type_to_univ(["hi! I'm a univ!"], Univ) }, 
+%%%	do_test(Univ),
+	
+		% test predicates	
+		% io__read_binary doesn't work for higher-order terms,
+		% so this test is expected to fail.
+	io__write_string("next text is expected to fail:\n"),
+	do_test(do_test),
+
+	{ true }.
+
+test_other -->
+	io__write_string("TESTING OTHER TYPES\n"),
+	{ term__init_var_supply(VarSupply) },
+	{ term__create_var(VarSupply, Var, NewVarSupply) },
+	do_test(Var),
+	do_test(VarSupply),
+	do_test(NewVarSupply),
+
+		% presently, at least, map is an equivalence and
+		% an abstract type.
+	{ map__init(Map) },
+	do_test(Map),
+
+		% a no tag type 
+	do_test(qwerty(4)),
+
+	{ array__from_list([1,2,3,4], Array) },
+	do_test(Array).
+
+do_test(Term) -->
+	try_io(do_test_2(Term), Result),
+	( { Result = succeeded(TermRead) } ->
+		io__print("test passed:\n"),
+		io__print(Term), io__nl,
+		io__print(TermRead), io__nl
+	;
+		io__print("test failed:\n"),
+		io__print(Result), io__nl,
+		io__print(Term), io__nl
+	).
+
+do_test_2(Term, TermRead) -->
+	io__make_temp(FileName),
+	io__open_binary_output(FileName, OutputRes),
+	( { OutputRes = ok(OutputStream) } ->
+		io__write_byte(OutputStream, 42),
+		io__write_binary(OutputStream, Term),
+		io__write_byte(OutputStream, 43),
+		io__close_binary_output(OutputStream),
+		io__open_binary_input(FileName, InputRes),
+		( { InputRes = ok(InputStream) } ->
+			io__read_byte(InputStream, B42),
+			io__read_binary(InputStream, Result),
+			io__read_byte(InputStream, B43),
+			io__close_binary_input(InputStream),
+			(
+				{ B42 = ok(42) },
+				% XXX currently we do not pass the B43 test,
+				% because of a bug in io__read_binary
+				%%% { B43 = ok(43) },
+				{ Result = ok(TermRead0) },
+				{ TermRead0 = Term }
+			->
+				io__print("ok... "),
+				{ TermRead = TermRead0 }
+			;
+				{ throw("error reading term back in again") }
+			)
+		;
+			{ throw(InputRes) }
+		)
+	;
+		{ throw(OutputRes) }
+	).

-- 
Fergus Henderson <fjh at cs.mu.oz.au>  |  "I have always known that the pursuit
The University of Melbourne         |  of excellence is a lethal habit"
WWW: <http://www.cs.mu.oz.au/~fjh>  |     -- the last words of T. S. Garp.
--------------------------------------------------------------------------
mercury-reviews mailing list
post:  mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe:   Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------



More information about the reviews mailing list