diff --git a/collects/lazy/lazy.rkt b/collects/lazy/lazy.rkt index e302b9a034..60ed30c82a 100644 --- a/collects/lazy/lazy.rkt +++ b/collects/lazy/lazy.rkt @@ -365,14 +365,22 @@ (or (null? xs) (let loop ([x (car xs)] [xs (cdr xs)]) (if (null? xs) x (and (! x) (loop (car xs) (cdr xs)))))))) - (defsubst (~and x ...) (hidden-~ (and (hidden-! x) ...)) ~and *and) + (define-syntax !and + (syntax-rules () + [(_) (and)] + [(_ x ... y) (and (hidden-! x) ... y)])) + (defsubst (~and x ...) (hidden-~ (!and x ...)) ~and *and) (define* (*or . xs) (let ([xs (!list xs)]) (and (pair? xs) (let loop ([x (car xs)] [xs (cdr xs)]) (if (null? xs) x (or (! x) (loop (car xs) (cdr xs)))))))) - (defsubst (~or x ...) (hidden-~ (or (hidden-! x) ...)) ~or *or) + (define-syntax !or + (syntax-rules () + [(_) (or)] + [(_ x ... y) (or (hidden-! x) ... y)])) + (defsubst (~or x ...) (hidden-~ (!or x ...)) ~or *or) ;; -------------------------------------------------------------------------- ;; Special forms that are still special forms since they use ~begin diff --git a/collects/tests/lazy/main.rkt b/collects/tests/lazy/main.rkt index d83898e135..5229ab30bd 100644 --- a/collects/tests/lazy/main.rkt +++ b/collects/tests/lazy/main.rkt @@ -1,7 +1,9 @@ #lang racket/base -(require tests/eli-tester "promise.rkt" "forcers.rkt" "lang.rkt") +(require tests/eli-tester "promise.rkt" "forcers.rkt" "lang.rkt" "space.rkt") (test do (promise-tests) do (forcer-tests) - do (lang-tests)) + do (lang-tests) + do (space-tests)) + diff --git a/collects/tests/lazy/space.rkt b/collects/tests/lazy/space.rkt new file mode 100644 index 0000000000..7a2f56ec1e --- /dev/null +++ b/collects/tests/lazy/space.rkt @@ -0,0 +1,46 @@ +#lang racket/base + +(require tests/eli-tester) + +;; tests for space safety, especially for `or' and `and' + +(define (space-tests) + (define (one-test first-class?) + (collect-garbage) + (define mem (current-memory-use)) + (define t + (thread + (lambda () + (parameterize ([current-namespace (make-base-namespace)]) + (eval + `(module loop lazy + (let () + (define (list-from n) + (if (= n 500000) + empty + (cons n (list-from (add1 n))))) + ,@(if first-class? + `((define my-or or) + (define my-and and)) + '()) + (define (has-negative? l) + (,(if first-class? 'my-and 'and) + (pair? l) + (,(if first-class? 'my-or 'or) + (negative? (car l)) + (has-negative? (rest l))))) + (! (has-negative? (list-from 0)))))) + (eval `(require 'loop)))))) + (thread (lambda () (let loop () + (sleep 0.2) + (unless ((current-memory-use) . < . (* 10 mem)) + (eprintf "too much memory!") + (kill-thread t)) + (when (thread-running? t) + (loop))))) + (sync t) + (void)) + (one-test #f) + (one-test #t)) + +(provide space-tests)