~ chicken-core (chicken-5) e570f2d698c2fe79f33670f68dbca533da28b00b
commit e570f2d698c2fe79f33670f68dbca533da28b00b
Author: felix <felix@call-with-current-continuation.org>
AuthorDate: Sun Sep 19 00:06:47 2010 +0200
Commit: felix <felix@call-with-current-continuation.org>
CommitDate: Sun Sep 19 00:06:47 2010 +0200
Revert "applied zbigniew's record-rename patch (finally), added test-case"
This reverts commit 727b2b3fea271474540f215af4842d32e82e7e6d.
Module-renaming records will not work with record-variants, and will
break coops. Since I can't think of a correct fix for this, the feature
will be removed for the time being.
diff --git a/chicken-syntax.scm b/chicken-syntax.scm
index f57ef506..4c049424 100644
--- a/chicken-syntax.scm
+++ b/chicken-syntax.scm
@@ -59,11 +59,8 @@
(lambda (x r c)
(##sys#check-syntax 'define-record x '(_ symbol . #(symbol 0)))
(let* ((name (cadr x))
- (prefix (symbol->string name))
- (name (if (##sys#current-module)
- (##sys#module-rename name (##sys#module-name (##sys#current-module)))
- name))
(slots (cddr x))
+ (prefix (symbol->string name))
(setters (memq #:record-setters ##sys#features))
(%define (r 'define))
(%getter-with-setter (r 'getter-with-setter)))
@@ -825,21 +822,11 @@
'define-record-printer (cons head body)
'((symbol symbol symbol) . #(_ 1)))
`(##sys#register-record-printer
- ',(if (##sys#current-module)
- (##sys#module-rename (##sys#slot head 0)
- (##sys#module-name
- (##sys#current-module)))
- (##sys#slot head 0))
+ ',(##sys#slot head 0)
(##core#lambda ,(##sys#slot head 1) ,@body)) ]
- (else
+ [else
(##sys#check-syntax 'define-record-printer (cons head body) '(symbol _))
- `(##sys#register-record-printer
- ',(if (##sys#current-module)
- (##sys#module-rename head
- (##sys#module-name
- (##sys#current-module)))
- head)
- ,@body) ) ) ))))
+ `(##sys#register-record-printer ',head ,@body) ] ) ))))
;;; Exceptions:
@@ -910,11 +897,7 @@
'define-record-type
form
'(_ variable #(variable 1) variable . _))
- (let* ((t (if (##sys#current-module)
- (##sys#module-rename (cadr form)
- (##sys#module-name
- (##sys#current-module)))
- (cadr form)))
+ (let* ((t (cadr form))
(conser (caddr form))
(pred (cadddr form))
(slots (cddddr form))
diff --git a/distribution/manifest b/distribution/manifest
index 9d12d6d9..6c2ceb82 100644
--- a/distribution/manifest
+++ b/distribution/manifest
@@ -100,7 +100,6 @@ tests/compiler-tests-2.scm
tests/compiler-tests-3.scm
tests/inlining-tests.scm
tests/locative-stress-test.scm
-tests/record-rename-test.scm
tests/r4rstest.scm
tests/null.scm
tests/sgrep.scm
diff --git a/tests/record-rename-test.scm b/tests/record-rename-test.scm
deleted file mode 100644
index 5a3e2ef6..00000000
--- a/tests/record-rename-test.scm
+++ /dev/null
@@ -1,33 +0,0 @@
-;;;; record-rename-test.scm
-
-
-(define-record foo a)
-
-(define-record-type bar
- (make-bar x)
- bar?
- (x get-x))
-
-
-(module m1 (make-foo make-bar)
-(import scheme chicken)
-
-(define-record foo a b)
-
-(define-record-type bar
- (make-bar x y)
- bar?
- (x get-x) (y get-y))
-
-)
-
-
-(let ((f1 (make-foo 1))
- (f2 (make-bar 2)))
- (print (list f1 f2)))
-
-(import m1)
-
-(let ((f1 (make-foo 1 2))
- (f2 (make-bar 3 4)))
- (print (list f1 f2)))
diff --git a/tests/runtests.sh b/tests/runtests.sh
index 3c8fc48e..d7f9fce0 100644
--- a/tests/runtests.sh
+++ b/tests/runtests.sh
@@ -222,9 +222,6 @@ echo "======================================== posix tests ..."
$compile posix-tests.scm
./a.out
-echo "======================================== record-renaming tests ..."
-$interpret -bnq record-rename-test.scm
-
echo "======================================== regular expression tests ..."
$interpret -bnq test-irregex.scm
$interpret -bnq test-glob.scm
Trap