~ chicken-core (chicken-5) 1e17a7003b78614b5b00e01a80b2e05100ba8117

commit 1e17a7003b78614b5b00e01a80b2e05100ba8117
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Sat Mar 19 18:19:58 2011 +0100
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Sat Mar 19 18:19:58 2011 +0100

    handle (const c-string) as foreign result type (fixes #541, eported by syn)

diff --git a/support.scm b/support.scm
index 94ab99e8..4afec0ee 100644
--- a/support.scm
+++ b/support.scm
@@ -1128,17 +1128,27 @@
     [(c-string-list) `(##sys#peek-c-string-list ,body '#f)]
     [(c-string-list*) `(##sys#peek-and-free-c-string-list ,body '#f)]
     [else
-     (cond 
-       [(and (list? type) (= 3 (length type)) 
-	     (memq (car type) '(instance instance-ref)))
-	(let ((tmp (gensym)))
-	  `(let ((,tmp ,body))
-	     (and ,tmp
-		  (not (##sys#null-pointer? ,tmp))
-		  (make ,(caddr type) 'this ,tmp) ) ) ) ]
-       [(and (list? type) (= 3 (length type)) (eq? 'nonnull-instance (car type)))
-	`(make ,(caddr type) 'this ,body) ]
-       [else body] ) ] ) )
+     (if (list? type)
+	 (if (and (eq? (car type) 'const)
+		  (= 2 (length type))
+		  (memq (cadr type) '(c-string c-string* unsigned-c-string
+					       unsigned-c-string* nonnull-c-string
+					       nonnull-c-string*
+					       nonnull-unsigned-string*)))
+	     (finish-foreign-result (cadr type) body)
+	     (if (= 3 (length type))
+		 (case (car type)
+		   ((instance instance-ref)
+		    (let ((tmp (gensym)))
+		      `(let ((,tmp ,body))
+			 (and ,tmp
+			      (not (##sys#null-pointer? ,tmp))
+			      (make ,(caddr type) 'this ,tmp) ) ) ) )
+		   ((nonnull-instance)
+		    `(make ,(caddr type) 'this ,body) )
+		   (else body))
+		 body))
+	 body)]))
 
 
 ;;; Scan expression-node for variable usage: