guile-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Guile-commits] GNU Guile branch, master, updated. release_1-9-12-190-g0


From: Ludovic Courtès
Subject: [Guile-commits] GNU Guile branch, master, updated. release_1-9-12-190-g08002ea
Date: Sun, 10 Oct 2010 17:16:20 +0000

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=08002eae4d8a9c0d36c2c4b53d4ec37c2d24a951

The branch, master has been updated
       via  08002eae4d8a9c0d36c2c4b53d4ec37c2d24a951 (commit)
       via  8e6c15a6f0425c7891ab3bdf267d56c1ac5804ae (commit)
       via  60f01304ee7bf3fca8d58ceca7aa122fd62c8910 (commit)
       via  cb6ff74394c5bfb7d4954e13946f91d33edfb86d (commit)
       via  e06972410a1f743edb8c8d78dc81eccbbac4ee5d (commit)
       via  89702c819caf6d1f3a21ef91d2d8f0df2945174e (commit)
      from  a531e76a74d4517aec0888d38d3c5e412ce67d1a (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 08002eae4d8a9c0d36c2c4b53d4ec37c2d24a951
Author: Ludovic Courtès <address@hidden>
Date:   Sun Oct 10 19:09:20 2010 +0200

    Fix typo.
    
    * module/system/repl/command.scm (repl-pop-continuation-resumer): Remove
      extraneous argument to `format'.

commit 8e6c15a6f0425c7891ab3bdf267d56c1ac5804ae
Author: Ludovic Courtès <address@hidden>
Date:   Sun Oct 10 19:08:11 2010 +0200

    Add warnings for obvious syntax errors in format strings.
    
    * module/language/tree-il/analyze.scm (&syntax-error): New variable.
      (format-string-argument-count): Throw to &SYNTAX-ERROR when a syntax
      error in a format string is encountered.
      (format-analysis): Catch &SYNTAX-ERROR and convert as a warning of the
      appropriate type.
    
    * module/system/base/message.scm (%warning-types)[format]: Handle
      `syntax-error' warnings.
    
    * test-suite/tests/tree-il.test
      ("warnings")["conditionals"]("unterminated", "unexpected ~;",
      "unexpected ~]"): New tests.
      ["unterminated ~{...~}"]: New test.

commit 60f01304ee7bf3fca8d58ceca7aa122fd62c8910
Author: Ludovic Courtès <address@hidden>
Date:   Sun Oct 10 18:10:18 2010 +0200

    Add new `format' warnings.
    
    * module/language/tree-il/analyze.scm (format-analysis): Add new
      sub-warnings: `wrong-port', `wrong-format-string',
      `non-literal-format-string', and `wrong-num-args'.
    
    * module/system/base/message.scm (%warning-types)[format]: Handle
      them.
    
    * test-suite/tests/tree-il.test ("warnings")["wrong port arg",
      "wrong format string", "non-literal format string",
      "wrong number of args"]: New tests.

commit cb6ff74394c5bfb7d4954e13946f91d33edfb86d
Author: Ludovic Courtès <address@hidden>
Date:   Sun Oct 10 17:13:36 2010 +0200

    Compile with `-Wformat'.
    
    * am/guilec (GUILE_WARNINGS): Add `-Wformat'.

commit e06972410a1f743edb8c8d78dc81eccbbac4ee5d
Author: Ludovic Courtès <address@hidden>
Date:   Sun Oct 10 17:13:21 2010 +0200

    Implement fancy format string analysis.
    
    * module/language/tree-il/analyze.scm (format-string-argument-count):
      Return two values, the minimum and maximum number of arguments.
      Add support for most of `format' escapes, including conditionals.
      (format-analysis): Adjust accordingly.
    
    * module/system/base/message.scm (%warning-types)[format]: Take two
      arguments, MIN and MAX, instead of EXPECTED.  Display warning
      accordingly.
    
    * test-suite/tests/tree-il.test ("warnings")["format"]("~%, ~~, ~&, ~t,
      ~_, and ~\\n", "~{...~}", "~{...~}, too many args", "address@hidden",
      "address@hidden, too few args", "~(...~)", "~v", "~v:@y", "~*", "~?",
      "complex 1", "complex 2", "complex 3"): New tests.
      ("conditionals"): New test prefix.

commit 89702c819caf6d1f3a21ef91d2d8f0df2945174e
Author: Ludovic Courtès <address@hidden>
Date:   Sat Oct 9 18:06:36 2010 +0200

    Escape newlines from format strings in warnings.
    
    * module/system/base/message.scm (%warning-types)[format]: Escape
      newlines from FMT.

-----------------------------------------------------------------------

Summary of changes:
 am/guilec                           |    2 +-
 module/language/tree-il/analyze.scm |  179 ++++++++++++++++++++---
 module/system/base/message.scm      |   62 ++++++++-
 module/system/repl/command.scm      |    4 +-
 test-suite/tests/tree-il.test       |  265 ++++++++++++++++++++++++++++++++++-
 5 files changed, 480 insertions(+), 32 deletions(-)

diff --git a/am/guilec b/am/guilec
index 5a7787e..a346832 100644
--- a/am/guilec
+++ b/am/guilec
@@ -1,7 +1,7 @@
 # -*- makefile -*-
 GOBJECTS = $(SOURCES:%.scm=%.go)
 
-GUILE_WARNINGS = -Wunbound-variable -Warity-mismatch
+GUILE_WARNINGS = -Wunbound-variable -Warity-mismatch -Wformat
 
 moddir = $(pkgdatadir)/$(GUILE_EFFECTIVE_VERSION)/$(modpath)
 nobase_mod_DATA = $(SOURCES) $(NOCOMP_SOURCES)
diff --git a/module/language/tree-il/analyze.scm 
b/module/language/tree-il/analyze.scm
index 0595793..8e7e2ef 100644
--- a/module/language/tree-il/analyze.scm
+++ b/module/language/tree-il/analyze.scm
@@ -1201,24 +1201,141 @@ accurate information is missing from a given `tree-il' 
element."
 ;;; `format' argument analysis.
 ;;;
 
+(define &syntax-error
+  ;; The `throw' key for syntax errors.
+  (gensym "format-string-syntax-error"))
+
 (define (format-string-argument-count fmt)
-  ;; Return the number of arguments that should follow format string
-  ;; FMT, or at least a good estimate thereof.
-
-  ;; FIXME: Implement ~[ conditionals.  Check
-  ;; `language/assembly/disassemble.scm' for an example.
-  (let loop ((chars  (string->list fmt))
-             (tilde? #f)
-             (count  0))
+  ;; Return the minimum and maxium number of arguments that should
+  ;; follow format string FMT (or, ahem, a good estimate thereof) or
+  ;; `any' if the format string can be followed by any number of
+  ;; arguments.
+
+  (define (drop-group chars end)
+    ;; Drop characters from CHARS until "~END" is encountered.
+    (let loop ((chars  chars)
+               (tilde? #f))
+      (if (null? chars)
+          (throw &syntax-error 'unterminated-iteration)
+          (if tilde?
+              (if (eq? (car chars) end)
+                  (cdr chars)
+                  (loop (cdr chars) #f))
+              (if (eq? (car chars) #\~)
+                  (loop (cdr chars) #t)
+                  (loop (cdr chars) #f))))))
+
+  (define (digit? char)
+    ;; Return true if CHAR is a digit, #f otherwise.
+    (memq char '(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)))
+
+  (define (previous-number chars)
+    ;; Return the previous series of digits found in CHARS.
+    (let ((numbers (take-while digit? chars)))
+      (and (not (null? numbers))
+           (string->number (list->string (reverse numbers))))))
+
+  (let loop ((chars       (string->list fmt))
+             (state       'literal)
+             (params      '())
+             (conditions  '())
+             (end-group   #f)
+             (min-count 0)
+             (max-count 0))
     (if (null? chars)
-        count
-        (if tilde?
-            (case (car chars)
-              ((#\~ #\%) (loop (cdr chars) #f count))
-              (else      (loop (cdr chars) #f (+ 1 count))))
-            (case (car chars)
-              ((#\~)     (loop (cdr chars) #t count))
-              (else      (loop (cdr chars) #f count)))))))
+        (if end-group
+            (throw &syntax-error 'unterminated-conditional)
+            (values min-count max-count))
+        (case state
+          ((tilde)
+           (case (car chars)
+             ((#\~ #\% #\& #\t #\_ #\newline #\( #\))
+                        (loop (cdr chars) 'literal '()
+                              conditions end-group
+                              min-count max-count))
+             ((#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9 #\, #\: #\@)
+                        (loop (cdr chars)
+                              'tilde (cons (car chars) params)
+                              conditions end-group
+                              min-count max-count))
+             ((#\v #\V) (loop (cdr chars)
+                              'tilde (cons (car chars) params)
+                              conditions end-group
+                              (+ 1 min-count)
+                              (+ 1 max-count)))
+             ((#\[)
+              (loop chars 'literal '() '()
+                    (let ((selector (previous-number params))
+                          (at?      (memq #\@ params)))
+                      (lambda (chars conds)
+                        ;; end of group
+                        (let ((mins (map car conds))
+                              (maxs (map cdr conds))
+                              (sel? (and selector
+                                         (< selector (length conds)))))
+                          (if (and (every number? mins)
+                                   (every number? maxs))
+                              (loop chars 'literal '() conditions end-group
+                                    (+ min-count
+                                       (if sel?
+                                           (car (list-ref conds selector))
+                                           (+ (if at? 0 1)
+                                              (if (null? mins)
+                                                  0
+                                                  (apply min mins)))))
+                                    (+ max-count
+                                       (if sel?
+                                           (cdr (list-ref conds selector))
+                                           (+ (if at? 0 1)
+                                              (if (null? maxs)
+                                                  0
+                                                  (apply max maxs))))))
+                              (values 'any 'any))))) ;; XXX: approximation
+                    0 0))
+             ((#\;)
+              (if end-group
+                  (loop (cdr chars) 'literal '()
+                        (cons (cons min-count max-count) conditions)
+                        end-group
+                        0 0)
+                  (throw &syntax-error 'unexpected-semicolon)))
+             ((#\])
+              (if end-group
+                  (end-group (cdr chars)
+                             (reverse (cons (cons min-count max-count)
+                                            conditions)))
+                  (throw &syntax-error 'unexpected-conditional-termination)))
+             ((#\{)     (if (memq #\@ params)
+                            (values min-count 'any)
+                            (loop (drop-group (cdr chars) #\})
+                                  'literal '()
+                                  conditions end-group
+                                  (+ 1 min-count) (+ 1 max-count))))
+             ((#\*)     (if (memq #\@ params)
+                            (values 'any 'any) ;; it's unclear what to do here
+                            (loop (cdr chars)
+                                  'literal '()
+                                  conditions end-group
+                                  (+ (or (previous-number params) 1)
+                                     min-count)
+                                  (+ (or (previous-number params) 1)
+                                     max-count))))
+             ((#\? #\k)
+              ;; We don't have enough info to determine the exact number
+              ;; of args, but we could determine a lower bound (TODO).
+              (values 'any 'any))
+             (else      (loop (cdr chars) 'literal '()
+                              conditions end-group
+                              (+ 1 min-count) (+ 1 max-count)))))
+          ((literal)
+           (case (car chars)
+             ((#\~)     (loop (cdr chars) 'tilde '()
+                              conditions end-group
+                              min-count max-count))
+             (else      (loop (cdr chars) 'literal '()
+                              conditions end-group
+                              min-count max-count))))
+          (else (error "computer bought the farm" state))))))
 
 (define format-analysis
   ;; Report arity mismatches in the given tree.
@@ -1232,13 +1349,29 @@ accurate information is missing from a given `tree-il' 
element."
      (define (check-format-args args loc)
        (pmatch args
          ((,port ,fmt . ,rest)
-          (guard (and (const? fmt) (string? (const-exp fmt))))
-          (let* ((fmt      (const-exp fmt))
-                 (expected (format-string-argument-count fmt))
-                 (actual   (length rest)))
-            (or (= expected actual)
-                (warning 'format loc fmt expected actual))))
-         (else #t)))
+          (guard (const? fmt))
+          (if (and (const? port)
+                   (not (boolean? (const-exp port))))
+              (warning 'format loc 'wrong-port (const-exp port)))
+          (let ((fmt   (const-exp fmt))
+                (count (length rest)))
+            (if (string? fmt)
+                (catch &syntax-error
+                  (lambda ()
+                    (let-values (((min max)
+                                  (format-string-argument-count fmt)))
+                      (and min max
+                           (or (and (or (eq? min 'any) (>= count min))
+                                    (or (eq? max 'any) (<= count max)))
+                               (warning 'format loc 'wrong-format-arg-count
+                                        fmt min max count)))))
+                  (lambda (_ key)
+                    (warning 'format loc 'syntax-error key fmt)))
+                (warning 'format loc 'wrong-format-string fmt))))
+         ((,port ,fmt . ,rest)
+          (warning 'format loc 'non-literal-format-string))
+         (else
+          (warning 'format loc 'wrong-num-args (length args)))))
 
      (define (resolve-toplevel name)
        (and (module? env)
diff --git a/module/system/base/message.scm b/module/system/base/message.scm
index 0486adc..62e7274 100644
--- a/module/system/base/message.scm
+++ b/module/system/base/message.scm
@@ -26,6 +26,7 @@
 (define-module (system base message)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-9)
+  #:use-module (ice-9 match)
   #:export (*current-warning-port* warning
 
             warning-type? warning-type-name warning-type-description
@@ -106,10 +107,63 @@
 
          (format
           "report wrong number of arguments to `format'"
-          ,(lambda (port loc fmt expected actual)
-             (format port
-                     "~A: warning: ~S: wrong number of `format' arguments: 
expected ~A, got ~A~%"
-                     loc fmt expected actual))))))
+          ,(lambda (port loc . rest)
+             (define (escape-newlines str)
+               (list->string
+                (string-fold-right (lambda (c r)
+                                     (if (eq? c #\newline)
+                                         (append '(#\\ #\n) r)
+                                         (cons c r)))
+                                   '()
+                                   str)))
+
+             (define (range min max)
+               (cond ((eq? min 'any)
+                      (if (eq? max 'any)
+                          "any number" ;; can't happen
+                          (format #f "up to ~a" max)))
+                     ((eq? max 'any)
+                      (format #f "at least ~a" min))
+                     ((= min max) (number->string min))
+                     (else
+                      (format #f "~a to ~a" min max))))
+
+             (match rest
+               (('wrong-format-arg-count fmt min max actual)
+                (format port
+                        "~A: warning: ~S: wrong number of `format' arguments: 
expected ~A, got ~A~%"
+                        loc (escape-newlines fmt)
+                        (range min max) actual))
+               (('syntax-error 'unterminated-iteration fmt)
+                (format port "~A: warning: ~S: unterminated iteration~%"
+                        loc (escape-newlines fmt)))
+               (('syntax-error 'unterminated-conditional fmt)
+                (format port "~A: warning: ~S: unterminated conditional~%"
+                        loc (escape-newlines fmt)))
+               (('syntax-error 'unexpected-semicolon fmt)
+                (format port "~A: warning: ~S: unexpected `~~;'~%"
+                        loc (escape-newlines fmt)))
+               (('syntax-error 'unexpected-conditional-termination fmt)
+                (format port "~A: warning: ~S: unexpected `~~]'~%"
+                        loc (escape-newlines fmt)))
+               (('wrong-port wrong-port)
+                (format port
+                        "~A: warning: ~S: wrong port argument~%"
+                        loc wrong-port))
+               (('wrong-format-string fmt)
+                (format port
+                        "~A: warning: ~S: wrong format string~%"
+                        loc fmt))
+               (('non-literal-format-string)
+                (format port
+                        "~A: warning: non-literal format string~%"
+                        loc))
+               (('wrong-num-args count)
+                (format port
+                        "~A: warning: wrong number of arguments to `format'~%"
+                        loc))
+               (else
+                (format port "~A: `format' warning~%" loc))))))))
 
 (define (lookup-warning-type name)
   "Return the warning type NAME or `#f' if not found."
diff --git a/module/system/repl/command.scm b/module/system/repl/command.scm
index f5512ff..ef2c5a6 100644
--- a/module/system/repl/command.scm
+++ b/module/system/repl/command.scm
@@ -612,9 +612,9 @@ Note that the given source location must be inside a 
procedure."
          (format #t "~a~%" msg)
          (let ((vals (frame-return-values from)))
            (if (null? vals)
-               (format #t "No return values.~%" msg)
+               (format #t "No return values.~%")
                (begin
-                 (format #t "Return values:~%" msg)
+                 (format #t "Return values:~%")
                  (for-each (lambda (x) (repl-print repl x)) vals))))
          ((module-ref (resolve-interface '(system repl repl)) 'start-repl)
           #:debug (make-debug stack 0 msg))))))
diff --git a/test-suite/tests/tree-il.test b/test-suite/tests/tree-il.test
index 2455c17..2294ef2 100644
--- a/test-suite/tests/tree-il.test
+++ b/test-suite/tests/tree-il.test
@@ -1104,10 +1104,50 @@
                           #:opts %opts-w-format
                           #:to 'assembly)))))
 
-     (pass-if "~% and ~~"
+     (pass-if "wrong port arg"
+       (let ((w (call-with-warnings
+                 (lambda ()
+                   (compile '(format 10 "foo")
+                            #:opts %opts-w-format
+                            #:to 'assembly)))))
+         (and (= (length w) 1)
+              (number? (string-contains (car w)
+                                        "wrong port argument")))))
+
+     (pass-if "non-literal format string"
+       (let ((w (call-with-warnings
+                 (lambda ()
+                   (compile '(format #f fmt)
+                            #:opts %opts-w-format
+                            #:to 'assembly)))))
+         (and (= (length w) 1)
+              (number? (string-contains (car w)
+                                        "non-literal format string")))))
+
+     (pass-if "wrong format string"
+       (let ((w (call-with-warnings
+                 (lambda ()
+                   (compile '(format #f 'not-a-string)
+                            #:opts %opts-w-format
+                            #:to 'assembly)))))
+         (and (= (length w) 1)
+              (number? (string-contains (car w)
+                                        "wrong format string")))))
+
+     (pass-if "wrong number of args"
+       (let ((w (call-with-warnings
+                 (lambda ()
+                   (compile '(format "shbweeb")
+                            #:opts %opts-w-format
+                            #:to 'assembly)))))
+         (and (= (length w) 1)
+              (number? (string-contains (car w)
+                                        "wrong number of arguments")))))
+
+     (pass-if "~%, ~~, ~&, ~t, ~_, and ~\\n"
        (null? (call-with-warnings
                (lambda ()
-                 (compile '(format some-port "~~ hey~%")
+                 (compile '(format some-port "~&~3_~~ ~\n~12they~%")
                           #:opts %opts-w-format
                           #:to 'assembly)))))
 
@@ -1151,6 +1191,227 @@
               (number? (string-contains (car w)
                                         "expected 1, got 2")))))
 
+     (with-test-prefix "conditionals"
+       (pass-if "literals"
+        (null? (call-with-warnings
+                (lambda ()
+                  (compile '(format #f "~A ~[foo~;bar~;baz~;~] ~10,2f"
+                                    'a 1 3.14)
+                           #:opts %opts-w-format
+                           #:to 'assembly)))))
+
+       (pass-if "literals with selector"
+         (let ((w (call-with-warnings
+                   (lambda ()
+                     (compile '(format #f "~2[foo~;bar~;baz~;~] ~A"
+                                       1 'dont-ignore-me)
+                              #:opts %opts-w-format
+                              #:to 'assembly)))))
+           (and (= (length w) 1)
+                (number? (string-contains (car w)
+                                          "expected 1, got 2")))))
+
+       (pass-if "escapes (exact count)"
+         (let ((w (call-with-warnings
+                   (lambda ()
+                     (compile '(format #f "~[~a~;~a~]")
+                              #:opts %opts-w-format
+                              #:to 'assembly)))))
+           (and (= (length w) 1)
+                (number? (string-contains (car w)
+                                          "expected 2, got 0")))))
+
+       (pass-if "escapes with selector"
+         (let ((w (call-with-warnings
+                   (lambda ()
+                     (compile '(format #f "~1[chbouib~;~a~]")
+                              #:opts %opts-w-format
+                              #:to 'assembly)))))
+           (and (= (length w) 1)
+                (number? (string-contains (car w)
+                                          "expected 1, got 0")))))
+
+       (pass-if "escapes, range"
+         (let ((w (call-with-warnings
+                   (lambda ()
+                     (compile '(format #f "~[chbouib~;~a~;~2*~a~]")
+                              #:opts %opts-w-format
+                              #:to 'assembly)))))
+           (and (= (length w) 1)
+                (number? (string-contains (car w)
+                                          "expected 1 to 4, got 0")))))
+
+       (pass-if "@"
+         (let ((w (call-with-warnings
+                   (lambda ()
+                     (compile '(format #f "address@hidden")
+                              #:opts %opts-w-format
+                              #:to 'assembly)))))
+           (and (= (length w) 1)
+                (number? (string-contains (car w)
+                                          "expected 1, got 0")))))
+
+       (pass-if "nested"
+         (let ((w (call-with-warnings
+                   (lambda ()
+                     (compile '(format #f "~:[~[hey~;~a~;~va~]~;~3*~]")
+                              #:opts %opts-w-format
+                              #:to 'assembly)))))
+           (and (= (length w) 1)
+                (number? (string-contains (car w)
+                                          "expected 2 to 4, got 0")))))
+
+       (pass-if "unterminated"
+         (let ((w (call-with-warnings
+                   (lambda ()
+                     (compile '(format #f "~[unterminated")
+                              #:opts %opts-w-format
+                              #:to 'assembly)))))
+           (and (= (length w) 1)
+                (number? (string-contains (car w)
+                                          "unterminated conditional")))))
+
+       (pass-if "unexpected ~;"
+         (let ((w (call-with-warnings
+                   (lambda ()
+                     (compile '(format #f "foo~;bar")
+                              #:opts %opts-w-format
+                              #:to 'assembly)))))
+           (and (= (length w) 1)
+                (number? (string-contains (car w)
+                                          "unexpected")))))
+
+       (pass-if "unexpected ~]"
+         (let ((w (call-with-warnings
+                   (lambda ()
+                     (compile '(format #f "foo~]")
+                              #:opts %opts-w-format
+                              #:to 'assembly)))))
+           (and (= (length w) 1)
+                (number? (string-contains (car w)
+                                          "unexpected"))))))
+
+     (pass-if "~{...~}"
+       (null? (call-with-warnings
+               (lambda ()
+                 (compile '(format #f "~A ~{~S~} ~A"
+                                   'hello '("ladies" "and")
+                                   'gentlemen)
+                          #:opts %opts-w-format
+                          #:to 'assembly)))))
+
+     (pass-if "~{...~}, too many args"
+       (let ((w (call-with-warnings
+                 (lambda ()
+                   (compile '(format #f "~{~S~}" 1 2 3)
+                            #:opts %opts-w-format
+                            #:to 'assembly)))))
+         (and (= (length w) 1)
+              (number? (string-contains (car w)
+                                        "expected 1, got 3")))))
+
+     (pass-if "address@hidden"
+       (null? (call-with-warnings
+               (lambda ()
+                 (compile '(format #f "address@hidden" 1 2 3)
+                          #:opts %opts-w-format
+                          #:to 'assembly)))))
+
+     (pass-if "address@hidden, too few args"
+       (let ((w (call-with-warnings
+                 (lambda ()
+                   (compile '(format #f "~A address@hidden")
+                            #:opts %opts-w-format
+                            #:to 'assembly)))))
+         (and (= (length w) 1)
+              (number? (string-contains (car w)
+                                        "expected at least 1, got 0")))))
+
+     (pass-if "unterminated ~{...~}"
+       (let ((w (call-with-warnings
+                 (lambda ()
+                   (compile '(format #f "~{")
+                            #:opts %opts-w-format
+                            #:to 'assembly)))))
+         (and (= (length w) 1)
+              (number? (string-contains (car w)
+                                        "unterminated")))))
+
+     (pass-if "~(...~)"
+       (null? (call-with-warnings
+               (lambda ()
+                 (compile '(format #f "~:@(~A ~A~)" 'foo 'bar)
+                          #:opts %opts-w-format
+                          #:to 'assembly)))))
+
+     (pass-if "~v"
+       (let ((w (call-with-warnings
+                 (lambda ()
+                   (compile '(format #f "~v_foo")
+                            #:opts %opts-w-format
+                            #:to 'assembly)))))
+         (and (= (length w) 1)
+              (number? (string-contains (car w)
+                                        "expected 1, got 0")))))
+     (pass-if "~v:@y"
+       (null? (call-with-warnings
+               (lambda ()
+                 (compile '(format #f "~v:@y" 1 123)
+                          #:opts %opts-w-format
+                          #:to 'assembly)))))
+
+
+     (pass-if "~*"
+       (let ((w (call-with-warnings
+                 (lambda ()
+                   (compile '(format #f "~2*~a" 'a 'b)
+                            #:opts %opts-w-format
+                            #:to 'assembly)))))
+         (and (= (length w) 1)
+              (number? (string-contains (car w)
+                                        "expected 3, got 2")))))
+
+     (pass-if "~?"
+       (null? (call-with-warnings
+               (lambda ()
+                 (compile '(format #f "~?" "~d ~d" '(1 2))
+                          #:opts %opts-w-format
+                          #:to 'assembly)))))
+
+     (pass-if "complex 1"
+       (let ((w (call-with-warnings
+                 (lambda ()
+                   (compile '(format #f
+                                     "address@hidden    address@hidden;; 
address@hidden@[~61t at ~a~]\n"
+                                     1 2 3 4 5 6)
+                            #:opts %opts-w-format
+                            #:to 'assembly)))))
+         (and (= (length w) 1)
+              (number? (string-contains (car w)
+                                        "expected 4, got 6")))))
+
+     (pass-if "complex 2"
+       (let ((w (call-with-warnings
+                 (lambda ()
+                   (compile '(format #f
+                                     "~:(~A~) Commands~:[~; [abbrev]~]:~2%"
+                                     1 2 3 4)
+                            #:opts %opts-w-format
+                            #:to 'assembly)))))
+         (and (= (length w) 1)
+              (number? (string-contains (car w)
+                                        "expected 2, got 4")))))
+
+     (pass-if "complex 3"
+       (let ((w (call-with-warnings
+                 (lambda ()
+                   (compile '(format #f "address@hidden:[~*~3_~;~3d~] ~v:@y~%")
+                            #:opts %opts-w-format
+                            #:to 'assembly)))))
+         (and (= (length w) 1)
+              (number? (string-contains (car w)
+                                        "expected 5, got 0")))))
+
      (pass-if "ice-9 format"
        (let ((w (call-with-warnings
                  (lambda ()


hooks/post-receive
-- 
GNU Guile



reply via email to

[Prev in Thread] Current Thread [Next in Thread]