mescc: Fix dumping of strings > M1_STRING_MAX.
authorJan Nieuwenhuizen <janneke@gnu.org>
Wed, 2 May 2018 13:53:37 +0000 (15:53 +0200)
committerJan Nieuwenhuizen <janneke@gnu.org>
Wed, 2 May 2018 13:53:37 +0000 (15:53 +0200)
* module/mes/M1.mes (object->M1): Skip opening quote.

module/mes/M1.mes

index 0f56ddefc3aa863e9566adce12700b19c011b865..1968121bb2073ed43cb1b5f674aeacfea82b5a30 100644 (file)
                          (string-append "&" label))))))
       (let* ((label (if (not (and (pair? (car o)) (eq? (caar o) #:string))) (car o)
                         (string->label (car o))))
                          (string-append "&" label))))))
       (let* ((label (if (not (and (pair? (car o)) (eq? (caar o) #:string))) (car o)
                         (string->label (car o))))
+             (string? (string-prefix? "_string" label))
              (foo (if (not (eq? (car (string->list label)) #\_))
                       (display (string-append "    :" label "\n") (current-error-port))))
              (data (cdr o))
              (data (filter-map labelize data))
              (len (length data))
              (foo (if (not (eq? (car (string->list label)) #\_))
                       (display (string-append "    :" label "\n") (current-error-port))))
              (data (cdr o))
              (data (filter-map labelize data))
              (len (length data))
-             (string-max (or (and=> (getenv "M1_STRING_MAX") string->number) 80)))
+             (string-max (or (and=> (getenv "M1_STRING_MAX") string->number) 256))
+             (string-data (and string? (list-head data (1- (length data))))))
         (display (string-append "\n:" label "\n"))
         (display (string-append "\n:" label "\n"))
-        (cond ((and (< len string-max)
-                    (char? (car data))
-                    (eq? (last data) #\nul)
-                    (not (find (cut memq <> '(#\nul #\backspace #\return #\" #\')) (list-head data (1- (length data)))))
-                    (not (any (lambda (ch) (>= (char->integer ch) #x80)) data)))
-               (display (string-append "\"" (list->string (list-head data (1- (length data)))) "\"")))
-              (else (display-join (map text->M1 data) " ")))
+        (if (and string-data
+                 (< len string-max)
+                 (char? (car data))
+                 (eq? (last data) #\nul)
+                 (not (find (cut memq <> '(#\")) string-data))
+                 (not (any (lambda (ch)
+                             (or (and (not (memq ch '(#\tab #\newline)))
+                                      (< (char->integer ch) #x20))
+                                 (>= (char->integer ch) #x80))) string-data)))
+            (display (string-append "\"" (list->string string-data) "\""))
+            (display-join (map text->M1 data) " "))
         (newline)))
     (display "M1: functions\n" (current-error-port))
     (for-each write-function (filter cdr functions))
         (newline)))
     (display "M1: functions\n" (current-error-port))
     (for-each write-function (filter cdr functions))