~ chicken-core (chicken-5) 61e95fb01611cc54dd88760bad24757bbfbea4c5

commit 61e95fb01611cc54dd88760bad24757bbfbea4c5
Author:     LemonBoy <thatlemon@gmail.com>
AuthorDate: Wed Nov 8 09:48:52 2017 +0100
Commit:     Evan Hanson <evhan@foldling.org>
CommitDate: Thu Nov 9 09:01:27 2017 +1300

    Streamline the behaviour of set-procedure-data!
    
    Make it return a ##core#undefined value like the other set! procedures.
    The entry in types.db already has the correct return type.
    
    Signed-off-by: felix <felix@call-with-current-continuation.org>
    Signed-off-by: Evan Hanson <evhan@foldling.org>

diff --git a/lolevel.scm b/lolevel.scm
index d1483496..c91a6510 100644
--- a/lolevel.scm
+++ b/lolevel.scm
@@ -461,15 +461,10 @@ EOF
        (and-let* ([d (%procedure-data x)])
 	 (##sys#slot d 1) ) ) )
 
-(define set-procedure-data!
-  (lambda (proc x)
-    (let ((p2 (extend-procedure proc x)))
-      (if (eq? p2 proc)
-	  proc
-	  (##sys#signal-hook
-	   #:type-error 'set-procedure-data!
-	   "bad argument type - not an extended procedure" proc) ) ) ) )
-
+(define (set-procedure-data! proc x)
+  (unless (eq? proc (extend-procedure proc x))
+    (##sys#signal-hook #:type-error 'set-procedure-data!
+     "bad argument type - not an extended procedure" proc)))
 
 ;;; Accessors for arbitrary vector-like block objects:
 
diff --git a/tests/lolevel-tests.scm b/tests/lolevel-tests.scm
index bb6c2990..332102a2 100644
--- a/tests/lolevel-tests.scm
+++ b/tests/lolevel-tests.scm
@@ -225,7 +225,7 @@
 
 (define unique-proc-data-2 '(23 'skidoo))
 
-(assert (eq? foo (set-procedure-data! foo unique-proc-data-2)))
+(set-procedure-data! foo unique-proc-data-2)
 
 (assert (eq? unique-proc-data-2 (procedure-data foo)))