[m-rev.] diff: structure reuse test cases

[Peter Ross]

Hi,


===================================================================


Estimated hours taken: 1
Branches: reuse

Add some more regression tests.

tests/general/structure_reuse/if_then_else.exp:
tests/general/structure_reuse/if_then_else.m:
    Test that branched control structures are treated correctly by the
    sr_choice pass.

tests/general/structure_reuse/Mmakefile:
tests/general/structure_reuse/interpret.exp:
tests/general/structure_reuse/interpret.m:
    Test the we only compile time gc the spine of a list, not the
    elements of a list.


Index: Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/general/structure_reuse/Mmakefile,v
retrieving revision 1.1
diff -u -r1.1 Mmakefile
--- Mmakefile	2001/03/30 10:43:19	1.1
+++ Mmakefile	2001/03/30 13:53:52
@@ -16,7 +16,11 @@
 
 # Any program added here should also be added to the `.cvsignore' file.
 
-PROGS=	internal_alias
+PROGS=	if_then_else		\
+	internal_alias		\
+	interpret
+
+MCFLAGS-interpret=--cell-cache
 
 ACC_FLAGS = --infer-structure-reuse -d structure_reuse -D sr
 
Index: if_then_else.exp
===================================================================
RCS file: if_then_else.exp
diff -N if_then_else.exp
--- /dev/null	Sat Aug  7 21:45:41 1999
+++ if_then_else.exp	Fri Mar 30 23:53:52 2001
@@ -0,0 +1 @@
+two(2, 1)
Index: if_then_else.m
===================================================================
RCS file: if_then_else.m
diff -N if_then_else.m
--- /dev/null	Sat Aug  7 21:45:41 1999
+++ if_then_else.m	Fri Mar 30 23:53:52 2001
@@ -0,0 +1,43 @@
+%-----------------------------------------------------------------------------%
+% A regression test.
+% We test that the determination of possible cons_ids a cell can have is
+% correct for branched goal structures, in this case the if_then_else.
+%-----------------------------------------------------------------------------%
+:- module if_then_else.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- type t
+	--->	empty
+	;	one(int)
+	;	two(int, int).
+
+main -->
+	{ X = two(1, 2) },
+	{ p(X, Y) },
+	io__write(Y),
+	io__nl.
+
+:- pred p(t::in, t::out) is det.
+
+p(X, Y) :-
+	( X = empty ->
+		Y = X
+	;
+		(
+			X = two(A, B),
+			Y = two(B, A)
+		;
+			X = one(A),
+			Y = one(A)
+		;
+			X = empty,
+			Y = empty
+		)
+	).
Index: interpret.exp
===================================================================
RCS file: interpret.exp
diff -N interpret.exp
--- /dev/null	Sat Aug  7 21:45:41 1999
+++ interpret.exp	Fri Mar 30 23:53:52 2001
@@ -0,0 +1,2 @@
+int(3)
+Element of map hasn't changed.
Index: interpret.m
===================================================================
RCS file: interpret.m
diff -N interpret.m
--- /dev/null	Sat Aug  7 21:45:41 1999
+++ interpret.m	Fri Mar 30 23:53:52 2001
@@ -0,0 +1,98 @@
+%-----------------------------------------------------------------------------%
+% A regression test.
+% This tests a case where the compiler marked cells as being compile
+% time garbage collectable, where references to that cell existed in
+% other data structures.
+%-----------------------------------------------------------------------------%
+:- module interpret.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- import_module exception, list, map, float, int, require.
+
+:- type element
+	--->	float(float)
+	;	int(int).
+
+
+:- type operation
+	--->	addf
+	;	addi
+	;	float(float)
+	;	lookup
+	;	pop.
+
+:- type stack == list(element).
+:- type env == map(int, element).
+
+main -->
+	{ Env = map__set(map__init, 1, int(5)) },
+	{ Stack0 = [int(1)] },
+	{ Ops = [lookup, float(3.14)] },
+	{ interpret(Ops, Env, Stack0, Stack1) },
+
+		% This list must be of at least length two to as the
+		% first cell is correctly marked as not being cgc'able.
+	{ Stack1 = [float(_), int(X0)] ->
+		X = X0
+	;
+		error("incorrect stack")
+	},
+		
+		% XXX If int(X0) is incorrectly being marked as cgc'able
+		% then P will reuse it's memory and hence the later
+		% map__lookup will return int(3) instead of int(5).
+	{ P = int(3) },
+	io__write(P),
+	io__nl,
+	{ map__lookup(Env, 1, Q) },
+	( { Q = int(X) } ->
+		io__write_string("Element of map hasn't changed.\n")
+	;
+		io__write_string("BEEP! BEEP! Map changed!!!.\n")
+	).
+
+:- pred interpret(list(operation)::in, env::in, stack::in, stack::out) is det.
+
+interpret([], _, Stack, Stack).
+interpret([Op | Ops], Env, Stack0, Stack) :-
+	do_op(Op, Env, Stack0, Stack1),
+	interpret(Ops, Env, Stack1, Stack).
+
+
+:- pred do_op(operation::in, env::in, stack::in, stack::out) is det.
+
+do_op(float(F), _Env, Stack, [float(F) | Stack]).
+do_op(addi, _Env, Stack0, Stack) :-
+	( Stack0 = [int(A), int(B) | Stack1] ->
+		Stack = [int(A+B) | Stack1]
+	;
+		throw(Stack0)
+	).
+do_op(addf, _Env, Stack0, Stack) :-
+	( Stack0 = [float(A), float(B) | Stack1] ->
+		Stack = [float(A+B) | Stack1]
+	;
+		error("addi: wrong arguments")
+	).
+do_op(lookup, Env, Stack0, Stack) :-
+	( Stack0 = [int(Loc) | Stack1] ->
+			% Here we create an alias between the Env
+			% variable and the elements in the stack.
+		map__lookup(Env, Loc, Element),
+		Stack = [Element | Stack1]
+	;
+		error("lookup: wrong arguments")
+	).
+do_op(pop, _Env, Stack0, Stack) :-
+	( Stack0 = [_ | Stack1] ->
+		Stack = Stack1
+	;
+		error("pop: no arguments on the stack")
+	).

--------------------------------------------------------------------------
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
--------------------------------------------------------------------------