diff options
author | Daniel Llorens <lloda@sarc.name> | 2023-02-23 17:38:10 +0100 |
---|---|---|
committer | Daniel Llorens <lloda@sarc.name> | 2023-02-27 11:53:48 +0100 |
commit | 3b47f87618047ebb8812788c64a44877a4f2e0dd (patch) | |
tree | 67b13b97da2ec938eb9778237b6179649ccd8272 /test-suite/tests/peval.test | |
parent | e2ed33ef0445c867fe56c247054aa67e834861f2 (diff) | |
download | guile-3b47f87618047ebb8812788c64a44877a4f2e0dd.tar.gz |
peval reduces some inlined case-lambda calls
* module/language/tree-il/peval.scm (peval): Reduce multiple case lambda
in <call> trees according to the number of arguments. Do not try to
reduce case-lambda using keyword arguments.
* test-suite/tests/peval.test: Tests.
Diffstat (limited to 'test-suite/tests/peval.test')
-rw-r--r-- | test-suite/tests/peval.test | 72 |
1 files changed, 72 insertions, 0 deletions
diff --git a/test-suite/tests/peval.test b/test-suite/tests/peval.test index a2e4975d9..8a8f0124a 100644 --- a/test-suite/tests/peval.test +++ b/test-suite/tests/peval.test @@ -1456,6 +1456,78 @@ ;; <https://bugs.gnu.org/60522>. (primcall make-vector))) +(with-test-prefix "case-lambda" + ;; one case + (pass-if-peval + ((case-lambda (() 0))) + (const 0)) + + ;; middle + (pass-if-peval + ((case-lambda (() 0) ((a b) 1) ((a) 2)) 1 2) + (const 1)) + + ;; last + (pass-if-peval + ((case-lambda ((a b) 0) ((a) 1) (() 2))) + (const 2)) + + ;; first + (pass-if-peval + ((case-lambda ((a) 0) (() 1) ((a b) 2)) 1) + (const 0)) + + ;; rest arg + (pass-if-peval + ((case-lambda (args 0) ((a b) 1) ((a) 2)) 1 2) + (const 0)) + + ;; req before rest I + (pass-if-peval + ((case-lambda ((a b) 0) (args 1) ((a) 1)) 1 2) + (const 0)) + + ;; req before rest II + (pass-if-peval + ((case-lambda ((a) 0) (args 1) ((a b) 2)) 1 2) + (const 1)) + + ;; optional + (pass-if-peval + ((case-lambda* ((a #:optional x) 0) (args 1) ((a) 2)) 1 2) + (const 0)) + + ;; optional and rest, no match I + (pass-if-peval + ((case-lambda* ((a #:optional x . rest) 0) (args 1) ((a) 2))) + (const 1)) + + ;; optional and rest, match I + (pass-if-peval + ((case-lambda* (() 0) ((a #:optional x . rest) 1) ((a) 2)) 1) + (const 1)) + + ;; optional and rest, match II + (pass-if-peval + ((case-lambda* ((a #:optional x . rest) 0) (args 1) ((a) 2)) 1) + (const 0)) + + ;; optional and rest, match III + (pass-if-peval + ((case-lambda* ((a #:optional x . rest) 0) (args 1) ((a) 2)) 1 2) + (const 0)) + + ;; optional and rest, match IV + (pass-if-peval + ((case-lambda* ((a #:optional x . rest) 0) (args 1) ((a) 2)) 1 2 3) + (const 0)) + + ;; keyword cases survive + (pass-if (= 1 ((case-lambda* ((a b) 0) ((a #:key x) 1)) 0 #:x 1))) + (pass-if (= 0 ((case-lambda* ((a b c) 0) ((a #:key x) 1)) 0 #:x 1))) + (pass-if (= 0 ((case-lambda* ((a #:key x) 0) ((a b) 0)) 0 #:x 1))) + (pass-if (= 1 ((case-lambda* ((a #:key x) 0) ((a b c) 1)) 0 1 2)))) + (with-test-prefix "eqv?" (pass-if-peval (eqv? x #f) (primcall eq? (toplevel x) (const #f))) |