diff --git a/collects/tests/mzscheme/port.ss b/collects/tests/mzscheme/port.ss index 0bb5279156..ad4d316624 100644 --- a/collects/tests/mzscheme/port.ss +++ b/collects/tests/mzscheme/port.ss @@ -512,14 +512,7 @@ [double (mk (lambda (l c p) (values (* 2 l) (* 2 c) (* 2 p))))] [none (mk (lambda (l c p) (values #f #f #f)))] - [bad (mk (let ([did-once? #f]) - (lambda (l c p) - (if did-once? - #f - (begin - ;; First call is from `port-count-lines!' - (set! did-once? #t) - (values l c p))))))]) + [bad (mk (lambda (l c p) #f))]) (test-values '(1 0 1) (lambda () (port-next-location plain))) (test-values '(2 0 2) (lambda () (port-next-location double))) (test-values '(#f #f #f) (lambda () (port-next-location none))) diff --git a/collects/tests/mzscheme/struct.ss b/collects/tests/mzscheme/struct.ss index 9009b4bba1..4a0a1578ae 100644 --- a/collects/tests/mzscheme/struct.ss +++ b/collects/tests/mzscheme/struct.ss @@ -102,8 +102,12 @@ (arity-test bmake 2 2) (arity-test bmakex 1 1) - (err/rt-test (make-struct-type 'bb type 0 0 #f (list (cons prop:p 12))) exn:application:mismatch?) - (err/rt-test (make-struct-type 'bb btype 0 0 #f (list (cons prop:p3 12))) exn:application:mismatch?) + ;; Override ok: + (make-struct-type 'bb type 0 0 #f (list (cons prop:p 12))) + (make-struct-type 'bb btype 0 0 #f (list (cons prop:p3 12))) + + (err/rt-test (make-struct-type 'bb type 0 0 #f (list (cons prop:p 12) (cons prop:p 12))) exn:application:mismatch?) + (err/rt-test (make-struct-type 'bb btype 0 0 #f (list (cons prop:p3 12) (cons prop:p3 12))) exn:application:mismatch?) (err/rt-test (make-struct-type 'bb #f 0 0 #f (list (cons prop:p 12) (cons prop:p2 12) (cons prop:p 12))) exn:application:mismatch?) (err/rt-test (make-struct-type 'bb type 0 0 #f (list (cons (let-values ([(p p? p-v) (make-struct-type-property 'p (lambda (v s) diff --git a/collects/tests/mzscheme/testing.ss b/collects/tests/mzscheme/testing.ss index 3b9899c1d5..3f94686f15 100644 --- a/collects/tests/mzscheme/testing.ss +++ b/collects/tests/mzscheme/testing.ss @@ -154,8 +154,8 @@ transcript. (current-exception-handler test-exn-handler) (error-escape-handler test-handler)) (lambda () - (let ([v (th)]) - (write v) + (let ([v (call-with-values th list)]) + (write (cons 'values v)) (display " BUT EXPECTED ERROR") (record-error (list v 'Error expr)) (newline) diff --git a/notes/mzscheme/HISTORY b/notes/mzscheme/HISTORY index 52c4b9e78d..3a9f0b1f1e 100644 --- a/notes/mzscheme/HISTORY +++ b/notes/mzscheme/HISTORY @@ -66,6 +66,9 @@ Libraries: slightly (i.e., they usually must write to a given port) Changed collects/web-server request-bindings/raw to return an alist of bytes, not strings +Misc: + Cygwin build produces a Unix-style installation instead of + a Windows-style installation (e.g., system-type is 'unix) Version 299.100, March 2005 >> See MzScheme_300.txt for information on major changes since diff --git a/src/mzscheme/src/struct.c b/src/mzscheme/src/struct.c index e4fc74fe77..69f679728d 100644 --- a/src/mzscheme/src/struct.c +++ b/src/mzscheme/src/struct.c @@ -2347,7 +2347,7 @@ static Scheme_Object *_make_struct_type(Scheme_Object *basesym, const char *base if (SAME_OBJ(SCHEME_CAR(pa[j]), prop)) break; } - if (j < i) { + if (j < num_props) { /* already there */ if (!scheme_hash_get(can_override, prop)) break;