Fast generic function dispatch without calling `compile' at runtime

[bpt/guile.git] / test-suite / tests / list.test

diff --git a/test-suite/tests/list.test b/test-suite/tests/list.test
index d7b7801..ff31c86 100644 (file)
--- a/test-suite/tests/list.test
+++ b/test-suite/tests/list.test
@@ -1,5 +1,5 @@
 ;;;; list.test --- tests guile's lists     -*- scheme -*-
-;;;; Copyright (C) 2000, 2001, 2006 Free Software Foundation, Inc.
+;;;; Copyright (C) 2000, 2001, 2006, 2011 Free Software Foundation, Inc.
 ;;;; 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -439,15 +439,15 @@
 
   (with-test-prefix "wrong argument"
 
-    (expect-fail-exception "improper list and empty list"
+    (pass-if-exception "improper list and empty list"
       exception:wrong-type-arg
       (append! (cons 1 2) '()))
 
-    (expect-fail-exception "improper list and list"
+    (pass-if-exception "improper list and list"
       exception:wrong-type-arg
       (append! (cons 1 2) (list 3 4)))
 
-    (expect-fail-exception "list, improper list and list"
+    (pass-if-exception "list, improper list and list"
       exception:wrong-type-arg
       (append! (list 1 2) (cons 3 4) (list 5 6)))
 
@@ -658,9 +658,26 @@
 
 ;;; memq
 
+(with-test-prefix/c&e "memq"
+
+  (pass-if "inline"
+    ;; In this case `memq' is inlined and the loop is unrolled.
+    (equal? '(b c d) (memq 'b '(a b c d))))
+
+  (pass-if "non inline"
+    ;; In this case a real function call is generated.
+    (equal? '(b c d) (memq 'b (list 'a 'b 'c 'd)))))
 
 ;;; memv
 
+(with-test-prefix/c&e "memv"
+  (pass-if "inline"
+    ;; In this case `memv' is inlined and the loop is unrolled.
+    (equal? '(b c d) (memv 'b '(a b c d))))
+
+  (pass-if "non inline"
+    ;; In this case a real function call is generated.
+    (equal? '(b c d) (memv 'b (list 'a 'b 'c 'd)))))
 
 ;;; member