[m-rev.] diff: fix tests/hard_coded/purity tests for erlang

[Peter Ross]

Hi,


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


Estimated hours taken: 1
Branches: main

hard_coded/purity/promise_pure_test.m:
hard_coded/purity/purity.m:
hard_coded/purity/purity_opt.m:
	Fix the test cases to work under erlang.


Index: hard_coded/purity/promise_pure_test.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/purity/promise_pure_test.m,v
retrieving revision 1.1
diff -u -r1.1 promise_pure_test.m
--- hard_coded/purity/promise_pure_test.m	24 Mar 2005 05:34:35 -0000	1.1
+++ hard_coded/purity/promise_pure_test.m	7 Jun 2007 06:26:46 -0000
@@ -21,17 +21,28 @@
 :- impure pred set_x(int::in) is det.
 :- pragma foreign_proc("C", set_x(X::in), [will_not_call_mercury], "x=X;" ).
 :- pragma foreign_proc("C#", set_x(X::in), [will_not_call_mercury], "x=X;" ).
+:- pragma foreign_proc("Erlang", set_x(X::in), [], "put(x, X)" ).
 :- pragma no_inline(set_x/1).
 
 :- semipure pred get_x(int::out) is det.
 :- pragma promise_semipure(get_x/1).
 :- pragma foreign_proc("C", get_x(X::out), [will_not_call_mercury], "X=x;").
 :- pragma foreign_proc("C#", get_x(X::out), [will_not_call_mercury], "X=x;").
+:- pragma foreign_proc("Erlang", get_x(X::out), [], "
+    X0 = get(x),
+    case X0 of
+        undefined ->
+            X = 0;
+        _ ->
+            X = X0
+    end
+").
 :- pragma no_inline(get_x/1).
 
 :- impure pred incr_x is det.
 :- pragma foreign_proc("C", incr_x, [will_not_call_mercury], "++x;" ).
 :- pragma foreign_proc("C#", incr_x, [will_not_call_mercury], "++x;" ).
+:- pragma foreign_proc("Erlang", incr_x, [], "put(x, get(x) + 1)" ).
 :- pragma no_inline(incr_x/0).
 
 :- pragma foreign_decl("C", "extern int x;").
Index: hard_coded/purity/purity.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/purity/purity.m,v
retrieving revision 1.3
diff -u -r1.3 purity.m
--- hard_coded/purity/purity.m	10 Jul 2006 04:40:55 -0000	1.3
+++ hard_coded/purity/purity.m	7 Jun 2007 06:26:46 -0000
@@ -44,6 +44,12 @@
 "
 	x = X;
 ").
+:- pragma foreign_proc("Erlang",
+	set_x(X::in),
+	[will_not_call_mercury],
+"
+    set_x(X)
+").
 
 :- impure pred incr_x is det.
 :- pragma no_inline(incr_x/0).
@@ -59,6 +65,12 @@
 "
 	++x;
 ").
+:- pragma foreign_proc("Erlang",
+	incr_x,
+	[will_not_call_mercury],
+"
+    incr_x()
+").
 
 :- semipure pred get_x(int::out) is det.
 :- pragma no_inline(get_x/1).
@@ -74,6 +86,12 @@
 "
 	X = x;
 ").
+:- pragma foreign_proc("Erlang",
+	get_x(X::out),
+	[will_not_call_mercury, promise_semipure],
+"
+	X = get_x()
+").
 
 :- impure pred set_x_inline(int::in) is det.
 :- pragma inline(set_x_inline/1).
@@ -89,6 +107,12 @@
 "
 	x = X;
 ").
+:- pragma foreign_proc("Erlang",
+	set_x_inline(X::in),
+	[will_not_call_mercury],
+"
+    set_x(X)
+").
 
 :- impure pred incr_x_inline is det.
 :- pragma inline(incr_x_inline/0).
@@ -104,6 +128,12 @@
 "
 	++x;
 ").
+:- pragma foreign_proc("Erlang",
+	incr_x_inline,
+	[will_not_call_mercury],
+"
+    incr_x()
+").
 
 :- semipure pred get_x_inline(int::out) is det.
 :- pragma inline(get_x_inline/1).
@@ -119,12 +149,31 @@
 "
 	X=x;
 ").
+:- pragma foreign_proc("Erlang",
+	get_x_inline(X::out),
+	[will_not_call_mercury, promise_semipure],
+"
+	X=get_x()
+").
 
 
 :- pragma foreign_decl("C", "extern int x;").
 :- pragma foreign_code("C", "int x = 0;").
 :- pragma foreign_code("C#", "static int x = 0;").
 
+:- pragma foreign_code("Erlang", "
+    get_x() ->
+        case get(x) of
+            undefined -> 0;
+            X -> X
+        end.
+
+    set_x(X) ->
+        put(x, X).
+
+    incr_x() ->
+        set_x(get_x() + 1).
+").
 
 % tempt compiler to optimize away duplicate semipure goals.
 test1 -->
Index: hard_coded/purity/purity_opt.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/purity/purity_opt.m,v
retrieving revision 1.1
diff -u -r1.1 purity_opt.m
--- hard_coded/purity/purity_opt.m	28 Feb 2003 00:21:42 -0000	1.1
+++ hard_coded/purity/purity_opt.m	7 Jun 2007 06:26:46 -0000
@@ -47,12 +47,26 @@
 
 :- pragma foreign_code("C#", "static int counter = 1;").
 
+:- pragma foreign_code("Erlang", "
+    get_counter() ->
+        case get(counter) of
+            undefined -> 1;
+            X -> X
+        end.
+
+    incr_counter() ->
+        put(counter, get_counter() + 1).
+").
+
+
 :- impure pred incr(int::out) is det.
 
 :- pragma foreign_proc("C", incr(Val::out), [will_not_call_mercury],
                         "counter++; Val = counter;").
 :- pragma foreign_proc("C#", incr(Val::out), [will_not_call_mercury],
                         "counter++; Val = counter;").
+:- pragma foreign_proc("Erlang", incr(Val::out), [will_not_call_mercury],
+                        "incr_counter(), Val = get_counter()").
 
 :- semipure pred get(int::out) is det.
 
@@ -62,4 +76,7 @@
 :- pragma foreign_proc("C#", get(Val::out),
                 [will_not_call_mercury, promise_semipure],
                 "Val = counter;").
+:- pragma foreign_proc("Erlang", get(Val::out),
+                [will_not_call_mercury, promise_semipure],
+                "Val = get_counter()").
 

--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to:       mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions:          mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------