All pastes #2055284 Raw Edit

fmt fix for C strings

public diff v1 · immutable
#2055284 ·published 2011-05-08 12:48 UTC
rendered paste body
diff --git a/fmt/private/fmt-c.scm b/fmt/private/fmt-c.scmindex f686406..8c1d51f 100644--- a/fmt/private/fmt-c.scm+++ b/fmt/private/fmt-c.scm@@ -88,15 +88,20 @@   (or (number? x) (string? x) (char? x) (boolean? x)))  (define (char->c-char c)-  (if (< 32 (char->integer c) 127)-      (if (or (eqv? #\' c) (eqv? #\\ c))-          (string #\' #\\ c #\')-          (string #\' c #\'))-      (case (char->integer c)-        ((7) "'\\a'") ((8) "'\\b'") ((9) "'\\t'") ((10) "'\\n'")-        ((11) "'\\v'") ((12) "'\\f'") ((13) "'\\r'")-        (else-         (string-append "'\\x" (number->string (char->integer c) 16) "'")))))+  (string-append "'" (c-escape-char c #\') "'"))++(define (c-escape-char c quote-char)+  (let ((n (char->integer c)))+    (if (<= 32 n 127)+        (if (or (eqv? c quote-char)+                (eqv? c #\\))+            (string #\\ c)+            (string c))+        (case n+          ((7) "\\a") ((8) "\\b") ((9) "\\t") ((10) "\\n")+          ((11) "\\v") ((12) "\\f") ((13) "\\r")+          (else+           (string-append "\\x" (number->string (char->integer c) 16)))))))  (define (c-format-number x)   (if (and (integer? x) (exact? x))@@ -108,6 +113,27 @@          st))       (dsp (number->string x)))) +(define (c-format-string x)+  (lambda (st)+    ((cat #\" (apply-cat (c-string-escaped x)) #\") st)))++(define (c-string-escaped x)+  (let loop ((parts '()) (idx (string-length x)))+    (cond ((string-index-right x c-needs-string-escape? 0 idx)+           => (lambda (special-idx)+                (loop (cons (c-escape-char (string-ref x special-idx) #\")+                            (cons (substring/shared x (+ special-idx 1) idx)+                                  parts))+                      special-idx)))+          (else+           (cons (substring/shared x 0 idx) parts)))))++(define (c-needs-string-escape? c)+  (let ((n (char->integer c)))+    (if (<= 32 n 127)+        (memv c '(#\" #\\))+        #t)))+ (define (c-simple-literal x)   (c-wrap-stmt    (cond ((char? x) (dsp (char->c-char x)))@@ -115,6 +141,7 @@          ((number? x) (c-format-number x))          ((null? x) (dsp "NULL"))          ((eof-object? x) (dsp "EOF"))+         ((string? x) (c-format-string x))          (else (dsp (write-to-string x))))))  (define (c-literal x)diff --git a/fmt/private/test-fmt-c.scm b/fmt/private/test-fmt-c.scmindex 88247f4..de67eee 100644--- a/fmt/private/test-fmt-c.scm+++ b/fmt/private/test-fmt-c.scm@@ -363,5 +363,8 @@ extern int foo (); (test "typedef double (*f)(double *, double, int);\n"     (fmt #f (c-typedef '(%fun double ((* double) double int)) 'f))) +(test "\"foo\\tbar\";\n"+      (fmt #f (c-expr "foo\tbar")))+ (test-end)