mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-12 06:41:13 +02:00
Code Activity

deprecate omission of port to ice-9 format

Browse source 
* module/ice-9/format.scm (format): Add port and format-string as formal
  arguments. Seems also to have triggered a reindent.  Formally
  deprecate omitting the port, as it's usually an error.

* test-suite/tests/format.test ("format basic output")
  ("format basic output", "~{ iteration"): Fix up tests that omitted the
  destination port.
This commit is contained in:
Andy Wingo 2010-12-18 12:06:53 +01:00
parent 29d096c8e6
commit 2ce77e6cf6
2 changed files with 72 additions and 53 deletions
Download patch file Download diff file Expand all files Collapse all files

117
module/ice-9/format.scm
View file

@ -44,15 +44,15 @@
;;; End of configuration ---------------------------------------------------- ;;; End of configuration ----------------------------------------------------
(define (format . args) (define (format port format-string . args)
(define format:version "3.0") (define format:version "3.0")
(define format:port #f) ; curr. format output port (define format:port #f) ; curr. format output port
(define format:output-col 0) ; curr. format output tty column (define format:output-col 0) ; curr. format output tty column
(define format:flush-output #f) ; flush output at end of formatting (define format:flush-output #f) ; flush output at end of formatting
(define format:case-conversion #f) (define format:case-conversion #f)
(define format:args #f) (define format:args #f)
(define format:pos 0) ; curr. format string parsing position (define format:pos 0) ; curr. format string parsing position
(define format:arg-pos 0) ; curr. format argument position (define format:arg-pos 0) ; curr. format argument position
; this is global for error presentation ; this is global for error presentation
;; format string and char output routines on format:port ;; format string and char output routines on format:port
@ -170,8 +170,8 @@
(else (else
(format:error "illegal destination `~a'" destination)))))) (format:error "illegal destination `~a'" destination))))))
(define (format:out port fmt args) ; the output handler for a port (define (format:out port fmt args) ; the output handler for a port
(set! format:port port) ; global port for (set! format:port port) ; global port for
; output routines ; output routines
(set! format:case-conversion #f) ; modifier case (set! format:case-conversion #f) ; modifier case
; conversion procedure ; conversion procedure
@ -190,9 +190,9 @@
#t)))) #t))))
(define format:parameter-characters (define format:parameter-characters
'(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9 #\- #\+ #\v #\# #\')) '(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9 #\- #\+ #\v #\# #\'))
(define (format:format-work format-string arglist) ; does the formatting work (define (format:format-work format-string arglist) ; does the formatting work
(letrec (letrec
((format-string-len (string-length format-string)) ((format-string-len (string-length format-string))
(arg-pos 0) ; argument position in arglist (arg-pos 0) ; argument position in arglist
@ -946,11 +946,11 @@
;; roman numerals (from dorai@cs.rice.edu). ;; roman numerals (from dorai@cs.rice.edu).
(define format:roman-alist (define format:roman-alist
'((1000 #\M) (500 #\D) (100 #\C) (50 #\L) '((1000 #\M) (500 #\D) (100 #\C) (50 #\L)
(10 #\X) (5 #\V) (1 #\I))) (10 #\X) (5 #\V) (1 #\I)))
(define format:roman-boundary-values (define format:roman-boundary-values
'(100 100 10 10 1 1 #f)) '(100 100 10 10 1 1 #f))
(define (format:num->old-roman n) (define (format:num->old-roman n)
(if (and (integer? n) (>= n 1)) (if (and (integer? n) (>= n 1))
@ -996,14 +996,14 @@
;; cardinals & ordinals (from dorai@cs.rice.edu) ;; cardinals & ordinals (from dorai@cs.rice.edu)
(define format:cardinal-ones-list (define format:cardinal-ones-list
'(#f "one" "two" "three" "four" "five" '(#f "one" "two" "three" "four" "five"
"six" "seven" "eight" "nine" "ten" "eleven" "twelve" "thirteen" "six" "seven" "eight" "nine" "ten" "eleven" "twelve" "thirteen"
"fourteen" "fifteen" "sixteen" "seventeen" "eighteen" "fourteen" "fifteen" "sixteen" "seventeen" "eighteen"
"nineteen")) "nineteen"))
(define format:cardinal-tens-list (define format:cardinal-tens-list
'(#f #f "twenty" "thirty" "forty" "fifty" "sixty" "seventy" "eighty" '(#f #f "twenty" "thirty" "forty" "fifty" "sixty" "seventy" "eighty"
"ninety")) "ninety"))
(define (format:num->cardinal999 n) (define (format:num->cardinal999 n)
;; this procedure is inspired by the Bruno Haible's CLisp ;; this procedure is inspired by the Bruno Haible's CLisp
@ -1037,11 +1037,11 @@
'())))))) '()))))))
(define format:cardinal-thousand-block-list (define format:cardinal-thousand-block-list
'("" " thousand" " million" " billion" " trillion" " quadrillion" '("" " thousand" " million" " billion" " trillion" " quadrillion"
" quintillion" " sextillion" " septillion" " octillion" " nonillion" " quintillion" " sextillion" " septillion" " octillion" " nonillion"
" decillion" " undecillion" " duodecillion" " tredecillion" " decillion" " undecillion" " duodecillion" " tredecillion"
" quattuordecillion" " quindecillion" " sexdecillion" " septendecillion" " quattuordecillion" " quindecillion" " sexdecillion" " septendecillion"
" octodecillion" " novemdecillion" " vigintillion")) " octodecillion" " novemdecillion" " vigintillion"))
(define (format:num->cardinal n) (define (format:num->cardinal n)
(cond ((not (integer? n)) (cond ((not (integer? n))
@ -1081,14 +1081,14 @@
s))))))))) s)))))))))
(define format:ordinal-ones-list (define format:ordinal-ones-list
'(#f "first" "second" "third" "fourth" "fifth" '(#f "first" "second" "third" "fourth" "fifth"
"sixth" "seventh" "eighth" "ninth" "tenth" "eleventh" "twelfth" "sixth" "seventh" "eighth" "ninth" "tenth" "eleventh" "twelfth"
"thirteenth" "fourteenth" "fifteenth" "sixteenth" "seventeenth" "thirteenth" "fourteenth" "fifteenth" "sixteenth" "seventeenth"
"eighteenth" "nineteenth")) "eighteenth" "nineteenth"))
(define format:ordinal-tens-list (define format:ordinal-tens-list
'(#f #f "twentieth" "thirtieth" "fortieth" "fiftieth" "sixtieth" '(#f #f "twentieth" "thirtieth" "fortieth" "fiftieth" "sixtieth"
"seventieth" "eightieth" "ninetieth")) "seventieth" "eightieth" "ninetieth"))
(define (format:num->ordinal n) (define (format:num->ordinal n)
(cond ((not (integer? n)) (cond ((not (integer? n))
@ -1386,15 +1386,15 @@
; the flonum buffers ; the flonum buffers
(define format:fn-max 400) ; max. number of number digits (define format:fn-max 400) ; max. number of number digits
(define format:fn-str #f) ; number buffer (define format:fn-str #f) ; number buffer
(define format:fn-len 0) ; digit length of number (define format:fn-len 0) ; digit length of number
(define format:fn-dot #f) ; dot position of number (define format:fn-dot #f) ; dot position of number
(define format:fn-pos? #t) ; number positive? (define format:fn-pos? #t) ; number positive?
(define format:en-max 10) ; max. number of exponent digits (define format:en-max 10) ; max. number of exponent digits
(define format:en-str #f) ; exponent buffer (define format:en-str #f) ; exponent buffer
(define format:en-len 0) ; digit length of exponent (define format:en-len 0) ; digit length of exponent
(define format:en-pos? #t) ; exponent positive? (define format:en-pos? #t) ; exponent positive?
(define (format:parse-float num fixed? scale) (define (format:parse-float num fixed? scale)
(let ((num-str (if (string? num) (let ((num-str (if (string? num)
@ -1540,7 +1540,7 @@
(string-set! format:en-str format:en-len c) (string-set! format:en-str format:en-len c)
(set! format:en-len (+ format:en-len 1))))))) (set! format:en-len (+ format:en-len 1)))))))
(define (format:fn-zfill left? n) ; fill current number string with 0s (define (format:fn-zfill left? n) ; fill current number string with 0s
(if (> (+ n format:fn-len) format:fn-max) ; from the left or right (if (> (+ n format:fn-len) format:fn-max) ; from the left or right
(format:error "number is too long to format (enlarge format:fn-max)")) (format:error "number is too long to format (enlarge format:fn-max)"))
(set! format:fn-len (+ format:fn-len n)) (set! format:fn-len (+ format:fn-len n))
@ -1555,7 +1555,7 @@
((= i format:fn-len)) ((= i format:fn-len))
(string-set! format:fn-str i #\0)))) (string-set! format:fn-str i #\0))))
(define (format:fn-shiftleft n) ; shift left current number n positions (define (format:fn-shiftleft n) ; shift left current number n positions
(if (> n format:fn-len) (if (> n format:fn-len)
(format:error "internal error in format:fn-shiftleft (~d,~d)" (format:error "internal error in format:fn-shiftleft (~d,~d)"
n format:fn-len)) n format:fn-len))
@ -1564,7 +1564,7 @@
(set! format:fn-len (- format:fn-len n))) (set! format:fn-len (- format:fn-len n)))
(string-set! format:fn-str (- i n) (string-ref format:fn-str i)))) (string-set! format:fn-str (- i n) (string-ref format:fn-str i))))
(define (format:fn-round digits) ; round format:fn-str (define (format:fn-round digits) ; round format:fn-str
(set! digits (+ digits format:fn-dot)) (set! digits (+ digits format:fn-dot))
(do ((i digits (- i 1)) ; "099",2 -> "10" (do ((i digits (- i 1)) ; "099",2 -> "10"
(c 5)) ; "023",2 -> "02" (c 5)) ; "023",2 -> "02"
@ -1622,10 +1622,10 @@
;;; some global functions not found in SLIB ;;; some global functions not found in SLIB
(define (string-capitalize-first str) ; "hello" -> "Hello" (define (string-capitalize-first str) ; "hello" -> "Hello"
(let ((cap-str (string-copy str)) ; "hELLO" -> "Hello" (let ((cap-str (string-copy str)) ; "hELLO" -> "Hello"
(non-first-alpha #f) ; "*hello" -> "*Hello" (non-first-alpha #f) ; "*hello" -> "*Hello"
(str-len (string-length str))) ; "hello you" -> "Hello you" (str-len (string-length str))) ; "hello you" -> "Hello you"
(do ((i 0 (+ i 1))) (do ((i 0 (+ i 1)))
((= i str-len) cap-str) ((= i str-len) cap-str)
(let ((c (string-ref str i))) (let ((c (string-ref str i)))
@ -1642,10 +1642,29 @@
(define (format:abort) (error "error in format")) (define (format:abort) (error "error in format"))
(set! format:error-save format:error) (set! format:error-save format:error)
(set! format:fn-str (make-string format:fn-max)) ; number buffer (set! format:fn-str (make-string format:fn-max)) ; number buffer
(set! format:en-str (make-string format:en-max)) ; exponent buffer (set! format:en-str (make-string format:en-max)) ; exponent buffer
(apply format:format port format-string args))
(begin-deprecated
(set! format
(let ((format format))
(case-lambda
((port format-string . args)
(if (string? port)
(begin
(issue-deprecation-warning
"Omitting the destination port on a call to format is deprecated."
"Pass #f as the destination port, before the format string.")
(apply format #f port format-string args))
(apply format port format-string args)))
((deprecated-format-string-only)
(issue-deprecation-warning
"Omitting the destination port on a call to format is deprecated."
"Pass #f as the destination port, before the format string.")
(format #f deprecated-format-string-only))))))
(apply format:format args))
;; Thanks to Shuji Narazaki ;; Thanks to Shuji Narazaki
(module-set! the-root-module 'format format) (module-set! the-root-module 'format format)

8
test-suite/tests/format.test
View file

@ -26,9 +26,9 @@
(with-test-prefix "format basic output" (with-test-prefix "format basic output"
(pass-if "format ~% produces a new line" (pass-if "format ~% produces a new line"
(string=? (format "~%") "\n")) (string=? (format #f "~%") "\n"))
(pass-if "format ~& starts a fresh line" (pass-if "format ~& starts a fresh line"
(string=? (format "~&abc~&~&") "abc\n")) (string=? (format #f "~&abc~&~&") "abc\n"))
(pass-if "format ~& is stateless but works properly across outputs via port-column" (pass-if "format ~& is stateless but works properly across outputs via port-column"
(string=? (string=?
(with-output-to-string (with-output-to-string
@ -39,7 +39,7 @@
(format #t "~&~&"))) (format #t "~&~&")))
"xyz\nabc\n")) "xyz\nabc\n"))
(pass-if "format ~F (format-out-substr) maintains the column correctly" (pass-if "format ~F (format-out-substr) maintains the column correctly"
(= (string-length (format "~@F~20T" 1)) 20))) (= (string-length (format #f "~@F~20T" 1)) 20)))
;;; ;;;
;;; misc ;;; misc
@ -99,4 +99,4 @@
;; In Guile 1.6.4 and earlier, the maximum iterations parameter defaulted ;; In Guile 1.6.4 and earlier, the maximum iterations parameter defaulted
;; to 100, but it's now like Common Lisp where the default is no limit ;; to 100, but it's now like Common Lisp where the default is no limit
(pass-if "no arbitrary iteration limit" (pass-if "no arbitrary iteration limit"
(= (string-length (format "~{~a~}" (make-list 200 #\b))) 200))) (= (string-length (format #f "~{~a~}" (make-list 200 #\b))) 200)))