Ticket #541: const-fix.patch

support.scm

@@ -1119 +1119 @@
 ;;; Convert result value, if a string:
 
 (define (finish-foreign-result type body)
-  (case type
+  (case (##sys#strip-syntax type)
     [(c-string unsigned-c-string) `(##sys#peek-c-string ,body '0)]
     [(nonnull-c-string) `(##sys#peek-nonnull-c-string ,body '0)]
     [(c-string* unsigned-c-string*) `(##sys#peek-and-free-c-string ,body '0)]
@@ -1129 +1129 @@
     [(c-string-list*) `(##sys#peek-and-free-c-string-list ,body '#f)]
     [else
      (if (list? type)
-         (if (and (eq? (car type) 'const)
+         (if (and (eq? (##sys#strip-syntax (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*)))
+                  (memq (##sys#strip-syntax (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)

tests/compiler-tests.scm

@@ -125 +125 @@
     (fp)))
 
 
+;; "const" qualifier should have no visible effect in Scheme
+(define-syntax generate-external
+  (syntax-rules ()
+    ((_) (define-external
+           (print_foo ((const c-string) foo))
+           void
+           (assert (string? foo))
+           (print foo)))))
+(generate-external)
+((foreign-safe-lambda* void () 
+   "print_foo(\"bar\");"))
+
+
 ;;; compiler-syntax for map/for-each must be careful when the
 ;   operator may have side-effects (currently only lambda exprs and symbols
 ;   are allowed)