mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-10 05:50:26 +02:00
Code Activity

Skip tests that don't work under letrectification

Browse source 
* test-suite/tests/srfi-64-test.scm: Skip a couple of tests that have
  unspecified result due to eq? being unspecified on procedures.
* module/language/tree-il/letrectify.scm (letrectify): Add a comment.
This commit is contained in:
Andy Wingo 2019-08-18 10:27:33 +02:00
parent 648bd5c431
commit 25be9f9c31
2 changed files with 22 additions and 9 deletions
Download patch file Download diff file Expand all files Collapse all files

13
module/language/tree-il/letrectify.scm
View file

@ -166,7 +166,18 @@
(define (residualize src mod name var expr) (define (residualize src mod name var expr)
(let ((lexical (make-lexical-ref src name var))) (let ((lexical (make-lexical-ref src name var)))
(match expr (match expr
;; Eta-expand so that we don't introduce functions-as-values. ;; Eta-expand references to declarative procedure definitions so
;; that adding these bindings to the module doesn't cause
;; otherwise "well-known" (in the sense of closure conversion)
;; procedures to become not well-known.
;;
;; Note, this means that eq? will always return #f when
;; comparing a value to a <lexical-ref> of a declarative
;; procedure definition, because the residualized reference is a
;; fresh value (the <lambda> literal we return here). This is
;; permitted by R6RS as procedure equality is explicitly
;; unspecified, but if it's an irritation in practice, we could
;; disable this transformation.
(($ <lambda> src1 meta (($ <lambda> src1 meta
($ <lambda-case> src2 req #f rest #f () syms body #f)) ($ <lambda-case> src2 req #f rest #f () syms body #f))
(let* ((syms (map gensym (map symbol->string syms))) (let* ((syms (map gensym (map symbol->string syms)))

18
test-suite/tests/srfi-64-test.scm
View file

@ -666,18 +666,20 @@
(test-end) (test-end)
(test-begin "8.2. test-runner-simple") (test-begin "8.2. test-runner-simple")
(test-assert "8.2.1. default on-test hook" ;; Procedure equality is explicitly unspecified by R6RS.
(eq? (test-runner-on-test-end (test-runner-simple)) ;; (test-assert "8.2.1. default on-test hook"
test-on-test-end-simple)) ;; (eq? (test-runner-on-test-end (test-runner-simple))
(test-assert "8.2.2. default on-final hook" ;; test-on-test-end-simple))
(eq? (test-runner-on-final (test-runner-simple)) ;; (test-assert "8.2.2. default on-final hook"
test-on-final-simple)) ;; (eq? (test-runner-on-final (test-runner-simple))
;; test-on-final-simple))
(test-end) (test-end)
(test-begin "8.3. test-runner-factory") (test-begin "8.3. test-runner-factory")
(test-assert "8.3.1. default factory" ;; Procedure equality is explicitly unspecified by R6RS.
(eq? (test-runner-factory) test-runner-simple)) ;; (test-assert "8.3.1. default factory"
;; (eq? (test-runner-factory) test-runner-simple))
(test-assert "8.3.2. settable factory" (test-assert "8.3.2. settable factory"
(with-factory-saved (with-factory-saved