From 1366d9ed223c6953df491260ecaeb3b3867006b2 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Tue, 26 Aug 2014 23:40:22 +0200
Subject: Handle ~p in 'format' warnings.
Fixes <http://bugs.gnu.org/18299>.
Reported by Frank Terbeck <ft@bewatermyfriend.org>.
* module/language/tree-il/analyze.scm (format-string-argument-count):
Add case for ~p.
* test-suite/tests/tree-il.test ("warnings")["format"]("~p", "~p, too
few arguments", "~:p", "~:@p, too many arguments", "~:@p, too few
arguments"): New tests.
Origin: http://git.savannah.gnu.org/cgit/guile.git/commit/?id=8ac39b38d14f47b6028030fa829f1fe7d0499f21
Added-by: Rob Browning <rlb@defaultvalue.org>
---
module/language/tree-il/analyze.scm | 13 ++++++++++-
test-suite/tests/tree-il.test | 44 +++++++++++++++++++++++++++++++++++++
2 files changed, 56 insertions(+), 1 deletion(-)
diff --git a/module/language/tree-il/analyze.scm b/module/language/tree-il/analyze.scm
index badce9f..ef625d4 100644
--- a/module/language/tree-il/analyze.scm
+++ b/module/language/tree-il/analyze.scm
@@ -1,6 +1,7 @@
;;; TREE-IL -> GLIL compiler
-;; Copyright (C) 2001, 2008, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2008, 2009, 2010, 2011, 2012,
+;; 2014 Free Software Foundation, Inc.
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@@ -1273,6 +1274,16 @@ accurate information is missing from a given `tree-il' element."
conditions end-group
(+ 1 min-count)
(+ 1 max-count)))
+ ((#\p #\P) (let* ((colon? (memq #\: params))
+ (min-count (if colon?
+ (max 1 min-count)
+ (+ 1 min-count))))
+ (loop (cdr chars) 'literal '()
+ conditions end-group
+ min-count
+ (if colon?
+ (max max-count min-count)
+ (+ 1 max-count)))))
((#\[)
(loop chars 'literal '() '()
(let ((selector (previous-number params))
diff --git a/test-suite/tests/tree-il.test b/test-suite/tests/tree-il.test
index 34bc810..f892033 100644
--- a/test-suite/tests/tree-il.test
+++ b/test-suite/tests/tree-il.test
@@ -1698,6 +1698,50 @@
(number? (string-contains (car w)
"expected 3, got 2")))))
+ (pass-if "~p"
+ (null? (call-with-warnings
+ (lambda ()
+ (compile '(((@ (ice-9 format) format) #f "thing~p" 2))
+ #:opts %opts-w-format
+ #:to 'assembly)))))
+
+ (pass-if "~p, too few arguments"
+ (let ((w (call-with-warnings
+ (lambda ()
+ (compile '((@ (ice-9 format) format) #f "~p")
+ #:opts %opts-w-format
+ #:to 'assembly)))))
+ (and (= (length w) 1)
+ (number? (string-contains (car w)
+ "expected 1, got 0")))))
+
+ (pass-if "~:p"
+ (null? (call-with-warnings
+ (lambda ()
+ (compile '(((@ (ice-9 format) format) #f "~d thing~:p" 2))
+ #:opts %opts-w-format
+ #:to 'assembly)))))
+
+ (pass-if "~:@p, too many arguments"
+ (let ((w (call-with-warnings
+ (lambda ()
+ (compile '((@ (ice-9 format) format) #f "~d pupp~:@p" 5 5)
+ #:opts %opts-w-format
+ #:to 'assembly)))))
+ (and (= (length w) 1)
+ (number? (string-contains (car w)
+ "expected 1, got 2")))))
+
+ (pass-if "~:@p, too few arguments"
+ (let ((w (call-with-warnings
+ (lambda ()
+ (compile '((@ (ice-9 format) format) #f "pupp~:@p")
+ #:opts %opts-w-format
+ #:to 'assembly)))))
+ (and (= (length w) 1)
+ (number? (string-contains (car w)
+ "expected 1, got 0")))))
+
(pass-if "~?"
(null? (call-with-warnings
(lambda ()