fixed check for duplicate struct type properties

svn: r504

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)))

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)

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)

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

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;