From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Maxim Cournoyer Newsgroups: gmane.lisp.guile.devel Subject: [PATCH v9 17/18] module: Add SRFI 48. Date: Tue, 12 Dec 2023 23:37:56 -0500 Message-ID: <20231213044217.14093-18-maxim.cournoyer@gmail.com> References: <20231213044217.14093-1-maxim.cournoyer@gmail.com> Mime-Version: 1.0 Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: 8bit Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="27001"; mail-complaints-to="usenet@ciao.gmane.io" Cc: Maxim Cournoyer To: guile-devel@gnu.org Original-X-From: guile-devel-bounces+guile-devel=m.gmane-mx.org@gnu.org Wed Dec 13 05:44:00 2023 Return-path: Envelope-to: guile-devel@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1rDH6G-0006l0-HP for guile-devel@m.gmane-mx.org; Wed, 13 Dec 2023 05:44:00 +0100 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1rDH5L-0004Yi-Sn; Tue, 12 Dec 2023 23:43:03 -0500 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1rDH5K-0004Xz-Te for guile-devel@gnu.org; Tue, 12 Dec 2023 23:43:02 -0500 Original-Received: from mail-qt1-x82c.google.com ([2607:f8b0:4864:20::82c]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1rDH5C-00079m-5j for guile-devel@gnu.org; Tue, 12 Dec 2023 23:43:02 -0500 Original-Received: by mail-qt1-x82c.google.com with SMTP id d75a77b69052e-42542b1ed5dso49848851cf.1 for ; Tue, 12 Dec 2023 20:42:53 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20230601; t=1702442573; x=1703047373; darn=gnu.org; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:from:to:cc:subject:date :message-id:reply-to; bh=636nw/8ifyzssmM1cPzQwA7M2PRsrzYxkNPa15AYTI4=; b=R3N/RXItzw4+eIpbdjMfcGX8XH1ZOcl7e0A1nEiT9s6FTLzl+9m9mlwtPh9jSWmrwl yI71lY070v1lsZ+TQQop79JdD8ajoYl6v3zzCTfM7cbvkiVc+X8CA3JPYrlwySAtw5U6 QA8vxd+OoRzC7VCyQbAHsDa/0kXQLziX7P++G+8SfCGVr+5YZ8mgOW9FAzmEmYgVOOw8 hh6QkAQBMT6WaPQFAia+BM9IASFO5BIo+BpzidCmrNDA/pccnjDEMHZAIYEHrdjShzYI ViEo05FBX03vDXJmmSuz0GT358LiYOqejU/hJ9IwwC75/ZtEvm8YkTH673VEfBmWjIB2 gPxw== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1702442573; x=1703047373; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:x-gm-message-state:from:to:cc :subject:date:message-id:reply-to; bh=636nw/8ifyzssmM1cPzQwA7M2PRsrzYxkNPa15AYTI4=; b=BoMJrtGvJrn8YMwgllttGSuUm4PWCvQDZb6z8JyKXlHqxp1+t9E6YeFYYEgWbAQWMY bvWQxU4L7XwzwxTxABpkdh79IJCESRNPPDdg9b/SowN4erP9xK613QUR7oDRdeza3yt+ QPg8SVwIn1HIPlsG+7M5erry4TJUAL5PtMfMC8LqAE5+VN2MT7eHbJvl/jPESAuXwcYu +pzvdYzYktwncH/VN6fIgNTQvI7c17OYh0Wiw10res0/ugbPZxm5JlPRbp1dKfu7KB30 E0us9ROTjtxtwpCko2cSAQoJzW16TYm/4jxsg6cUebenLTPyD+WahvF3+Zz81l2XoLbJ yDTw== X-Gm-Message-State: AOJu0Ywj9jvuC8VLui0zu1tgp5LtCHmrTwVZoL47SVGk80aCq3O90wK/ C/9bc6r+vW1EgbgwYvfMQFW+j9SjLlAvig== X-Google-Smtp-Source: AGHT+IF5GIthkqbPJqoGnV4oVHR5Vv2jR/Dovub4feDU+ixwqq9o9UctZXDT4IAO5xCxTqDs/Ra2uw== X-Received: by 2002:ac8:5a8d:0:b0:425:4043:96fa with SMTP id c13-20020ac85a8d000000b00425404396famr11426694qtc.135.1702442572112; Tue, 12 Dec 2023 20:42:52 -0800 (PST) Original-Received: from localhost.localdomain (dsl-157-186.b2b2c.ca. [66.158.157.186]) by smtp.gmail.com with ESMTPSA id s7-20020ac87587000000b004181138e0c0sm4621719qtq.31.2023.12.12.20.42.51 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Tue, 12 Dec 2023 20:42:51 -0800 (PST) X-Mailer: git-send-email 2.41.0 In-Reply-To: <20231213044217.14093-1-maxim.cournoyer@gmail.com> Received-SPF: pass client-ip=2607:f8b0:4864:20::82c; envelope-from=maxim.cournoyer@gmail.com; helo=mail-qt1-x82c.google.com X-Spam_score_int: -20 X-Spam_score: -2.1 X-Spam_bar: -- X-Spam_report: (-2.1 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, FREEMAIL_FROM=0.001, RCVD_IN_DNSWL_NONE=-0.0001, SPF_HELO_NONE=0.001, SPF_PASS=-0.001, T_SCC_BODY_TEXT_LINE=-0.01 autolearn=ham autolearn_force=no X-Spam_action: no action X-BeenThere: guile-devel@gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: "Developers list for Guile, the GNU extensibility library" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guile-devel-bounces+guile-devel=m.gmane-mx.org@gnu.org Original-Sender: guile-devel-bounces+guile-devel=m.gmane-mx.org@gnu.org Xref: news.gmane.io gmane.lisp.guile.devel:22239 Archived-At: * module/srfi/srfi-48.sld: New file. * module/srfi/srfi-48/48.body.scm: Likewise. * am/bootstrap.am (srfi/srfi-48.go): New target. (SOURCES): Register srfi/srfi-48.sld. (NOCOMP_SOURCES): Register srfi/srfi-48/48.upstream.scm. * test-suite/tests/srfi-48.test: New test. * test-suite/Makefile.am (SCM_TESTS): Register it. --- (no changes since v1) NEWS | 1 + am/bootstrap.am | 5 +- doc/ref/guile.texi | 6 +- doc/ref/srfi-modules.texi | 264 ++++++++++++++++++ module/srfi/srfi-48.sld | 14 + module/srfi/srfi-48/48.upstream.scm | 409 ++++++++++++++++++++++++++++ test-suite/Makefile.am | 1 + test-suite/tests/srfi-48.test | 320 ++++++++++++++++++++++ 8 files changed, 1016 insertions(+), 4 deletions(-) create mode 100644 module/srfi/srfi-48.sld create mode 100644 module/srfi/srfi-48/48.upstream.scm create mode 100644 test-suite/tests/srfi-48.test diff --git a/NEWS b/NEWS index a269e0776..1c4dd7b56 100644 --- a/NEWS +++ b/NEWS @@ -21,6 +21,7 @@ definitely unused---this is notably the case for modules that are only used at macro-expansion time, such as (srfi srfi-26). In those cases, the compiler reports it as "possibly unused". +** Add (srfi 48), a string format library ** Add (srfi 126), a hash tables library ** Add (srfi 128), a comparators library ** Add (scheme comparator) diff --git a/am/bootstrap.am b/am/bootstrap.am index 343fe6dcd..67460b32d 100644 --- a/am/bootstrap.am +++ b/am/bootstrap.am @@ -54,8 +54,10 @@ COMPILE = $(AM_V_GUILEC) \ .el.go: $(COMPILE) --from=elisp -o "$@" "$<" +# Rebuild modules when their included sources have changes. ice-9/boot-9.go: ice-9/boot-9.scm ice-9/quasisyntax.scm ice-9/r6rs-libraries.scm ice-9/r7rs-libraries.scm ice-9/read.scm ice-9/match.go: ice-9/match.scm ice-9/match.upstream.scm +srfi/srfi-48.go: srfi/srfi-48/48.upstream.scm srfi/srfi-64.go: srfi/srfi-64.scm srfi/srfi-64/testing.scm # Keep this rule in sync with that in `am/guilec'. @@ -358,6 +360,7 @@ SOURCES = \ srfi/srfi-43.scm \ srfi/srfi-39.scm \ srfi/srfi-45.scm \ + srfi/srfi-48.sld \ srfi/srfi-60.scm \ srfi/srfi-64.scm \ srfi/srfi-67.scm \ @@ -474,7 +477,7 @@ NOCOMP_SOURCES = \ ice-9/quasisyntax.scm \ scheme/features.scm \ srfi/srfi-42/ec.scm \ - srfi/srfi-64/testing.scm \ + srfi/srfi-48/48.upstream.scm \ srfi/srfi-67/compare.scm \ srfi/srfi-125/125.body.scm \ srfi/srfi-128/128.body1.scm \ diff --git a/doc/ref/guile.texi b/doc/ref/guile.texi index f2a2d08f4..9be1b7540 100644 --- a/doc/ref/guile.texi +++ b/doc/ref/guile.texi @@ -24,9 +24,9 @@ Invariant Sections, no Front-Cover Texts, and no Back-Cover Texts. A copy of the license is included in the section entitled ``GNU Free Documentation License.'' -Additionally, the documentation of the 125, 126, 128, 151, 160, 178 and -209 SRFI modules is adapted from their specification text, which is made -available under the following Expat license: +Additionally, the documentation of the 48, 125, 126, 128, 151, 160, 178 +and 209 SRFI modules is adapted from their specification text, which is +made available under the following Expat license: Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the diff --git a/doc/ref/srfi-modules.texi b/doc/ref/srfi-modules.texi index 3ca18979f..650d7f27f 100644 --- a/doc/ref/srfi-modules.texi +++ b/doc/ref/srfi-modules.texi @@ -2,6 +2,7 @@ @c This is part of the GNU Guile Reference Manual. @c Copyright (C) 1996, 1997, 2000-2004, 2006, 2007-2014, 2017, 2018, 2019, 2020 @c Free Software Foundation, Inc. +@c Copyright (C) 2003 Kenneth A Dickey @c Copyright (C) 2015-2016 Taylan Ulrich Bayırlı/Kammer @c Copyright (C) 2015-2016, 2018, 2020 John Cowan @c See the file guile.texi for copying conditions. @@ -53,6 +54,7 @@ get the relevant SRFI documents from the SRFI home page * SRFI-43:: Vector Library. * SRFI-45:: Primitives for expressing iterative lazy algorithms * SRFI-46:: Basic syntax-rules Extensions. +* SRFI 48:: Intermediate Format Strings. * SRFI-55:: Requiring Features. * SRFI-60:: Integers as bits. * SRFI-61:: A more general `cond' clause @@ -5108,6 +5110,268 @@ SRFI-46/R7RS. Tail patterns have been supported since at least Guile 2.0, and custom ellipsis identifiers have been supported since Guile 2.0.10. @xref{Syntax Rules}. +@node SRFI 48 +@subsection SRFI 48: Intermediate Format Strings +@cindex SRFI 48 + +@menu +* SRFI 48 Abstract:: +* SRFI 48 Rationale:: +* SRFI 48 Specification:: +@end menu + +@node SRFI 48 Abstract +@subsubsection SRFI 48 Abstract + +This document specifies Format Strings, a method of interpreting a +Scheme string which contains a number of format directives that are +replaced with other string data according to the semantics of each +directive. This SRFI extends SRFI 28 in being more generally useful but +is less general than advanced format strings in that it does not allow, +aside from ~F, for controlled positioning of text within fields. + +@node SRFI 48 Rationale +@subsubsection SRFI 48 Rationale + +Inheriting from MacLisp, nearly all Lisp and Scheme implementations +support some form of FORMAT function with support for various numbers of +format directives. By agreeing to the options here, we raise the bar +for portable code. + +The reference implementation is R5RS compliant and easy to port. In not +requiring advanced features (aside from @samp{~W} and @samp{~F}) small +implementations are possible. E.g.@: the reference code does not use +side effects (assignment) and is less than a third the source size of +the latest SLIB implementation of FORMAT (less than a tenth if @samp{~F} +support is elided). + +The optional @var{port} argument allows for compatibility with older +code written for, e.g.@: scheme48, MIT Scheme, T, et cetera, which +required a port argument. It is also useful in cases where a synoptic +implementation of Scheme and CommonLisp is maintained. + +@node SRFI 48 Specification +@subsubsection SRFI 48 Specification + +@deffn format [port] format-string [obj @dots{}] + +Accepts a format template (a Scheme String), and processes it, replacing +any format directives in order with one or more characters, the +characters themselves dependent on the semantics of the format directive +encountered. Each directive may consume one @var{obj}. It is an error +if fewer or more @var{obj} values are provided than format directives +that require them. + +When @var{port} is specified it must be either an output port or a +boolean. If an output port is specified, the formatted output is output +into that port. If the @var{port} argument is @code{#t}, output is to +the @code{current-output-port}. If @var{port} is @code{#f} or no port +is specified, the output is returned as a string. If @var{port} is +specified and is @code{#t} or an output port, the result of the format +function is unspecified. + +It is unspecified which encoding is used (e.g.@: ASCII, EBCDIC, +UNICODE). A given implementation must specify which encoding is used. +The implementation may or may not allow the encoding to be selected or +changed. + +It is an error if a format directive consumes an @var{obj} argument and +that argument does not confirm to a required type as noted in the table +below. + +It is permissible, but highly discouraged, to implement +@code{pretty-print} as @samp{(define pretty-print write)}. + +A format directive is a two character sequence in the string where the +first character is a tilde '~'. Directive characters are +case-independent, i.e.@: upper and lower case characters are interpreted +the same. Each directive code's meaning is described in the following +table: + +@multitable @columnfractions .125 .20 .55 .125 +@headitem Directive @tab Mnemonic @tab Action @tab Consumes? +@item ~a @tab Any @tab (display obj) for humans @tab yes +@item ~s @tab Slashified @tab (write obj) for parsers @tab yes + +@item ~w @tab WriteCircular +@tab (write-with-shared-structure obj) like ~s, but handles recursive structures +@tab yes + +@item ~d @tab Decimal +@tab the obj is a number which is output in decimal radix @tab yes + +@item ~x @tab heXadecimal +@tab the obj is a number which is output in hexdecimal radix @tab yes + +@item ~o @tab Octal +@tab the obj is a number which is output in octal radix @tab yes + +@item ~b @tab Binary +@tab the obj is a number which is output in binary radix @tab yes + +@item ~c @tab Character +@tab the single charater obj is output by write-char @tab yes + +@item ~y @tab Yuppify +@tab the list obj is pretty-printed to the output @tab yes + +@item ~? @tab Indirection +@tab the obj is another format-string and the following obj is a list +of arguments; format is called recursively @tab yes + +@item ~K @tab Indirection +@tab the same as ~? for backward compatibility with +some existing implementations @tab yes + +@item ~[w[,d]]F @tab Fixed +@tab ~w,dF outputs a number with width w and d digits after the decimal; +~wF outputs a string or number with width w. @tab yes + +@item ~~ @tab Tilde @tab output a tilde @tab no +@item ~t @tab Tab @tab output a tab character @tab no +@item ~% @tab Newline @tab output a newline character @tab no + +@item ~& @tab Freshline +@tab output a newline character if it is known that the previous +output was not a newline @tab no + +@item ~_ @tab Space @tab a single space character is output @tab no + +@item ~h @tab Help +@tab outputs one line of call synopsis, one line of comment, and one line of +synopsis for each format directive, starting with the directive (e.g. "~t") +@tab no +@end multitable + +The @samp{~F}, fixed format, directive requires some elucidation. + +@samp{~wF} is useful for strings or numbers. Where the string (or +@code{number->string} of the number) has fewer characters than the +integer width @samp{w}, the string is padded on the left with space +characters. + +@samp{~w,dF} is typically used only on numbers. For strings, the +@samp{d} specifier is ignored. For numbers, the integer @samp{d} +specifies the number of decimal digits after the decimal place. Both +@samp{w} and @samp{d} must be zero or positive. + +If @samp{d} is specified, the number is processed as if added to 0.0, +i.e.@: it is converted to an inexact value. + +@lisp +(format "~8,2F" 1/3) => " 0.33" +@end lisp + +If no @samp{d} is specified, the number is @emph{not} coerced to +inexact. + +@lisp +(format "~6F" 32) => " 32" +@end lisp + +Digits are padded to the right with zeros. + +@lisp +(format "~8,2F" 32) => " 32.00" +@end lisp + +If the number is too large to fit in the width specified, a string +longer than the width is returned. + +@lisp +(format "~1,2F" 4321) => "4321.00" +@end lisp + +If the number is complex, @samp{d} is applied to both real and imaginal +parts. + +@lisp +(format "~1,2F" (sqrt -3.9)) => "0.00+1.97i" +@end lisp + +For very large or very small numbers, the point where exponential +notation is used is implementation defined. + +@lisp +(format "~8F" 32e5) => " 3.2e6" or "3200000.0" +@end lisp + +@subsubheading Examples + +@lisp +(format "~h") +; => +"(format [] [@dots{}]) -- is #t, #f or an output-port +OPTION [MNEMONIC] DESCRIPTION -- This implementation Assumes ASCII Text Encoding +~H [Help] output this text +~A [Any] (display arg) for humans +~S [Slashified] (write arg) for parsers +~~ [tilde] output a tilde +~T [Tab] output a tab character +~% [Newline] output a newline character +~& [Freshline] output a newline character if the previous output was not a newline +~D [Decimal] the arg is a number which is output in decimal radix +~X [heXadecimal] the arg is a number which is output in hexdecimal radix +~O [Octal] the arg is a number which is output in octal radix +~B [Binary] the arg is a number which is output in binary radix +~w,dF [Fixed] the arg is a string or number which has width w and d digits after the decimal +~C [Character] charater arg is output by write-char +~_ [Space] a single space character is output +~Y [Yuppify] the list arg is pretty-printed to the output +~? [Indirection] recursive format: next arg is a format-string and the following arg a list of arguments +~K [Indirection] same as ~? +" +(format "Hello, ~a" "World!") +; => "Hello, World!" +(format "Error, list is too short: ~s" '(one "two" 3)) +; => "Error, list is too short: (one \"two\" 3)" +(format "test me") +; => "test me" +(format "~a ~s ~a ~s" 'this 'is "a" "test") +; => "this is a \"test\"" +(format #t "#d~d #x~x #o~o #b~b~%" 32 32 32 32) +;; Prints: #d32 #x20 #o40 #b100000 +; => +(format "~a ~? ~a" 'a "~s" '(new) 'test) +; =>"a new test" +(format #f "~&1~&~&2~&~&~&3~%") +; => +" +1 +2 +3 +" +(format #f "~a ~? ~a ~%" 3 " ~s ~s " '(2 2) 3) +; => +"3 2 2 3 +" +(format "~w" (let ( (c '(a b c)) ) (set-cdr! (cddr c) c) c)) +; => "#1=(a b c . #1#)" +(format "~8,2F" 32) +; => " 32.00" +(format "~8,3F" (sqrt -3.8)) +; => "0.000+1.949i" +(format "~8,2F" 3.4567e11) +; => " 3.45e11" +(format "~6,3F" 1/3) +; => " 0.333" +(format "~4F" 12) +; => " 12" +(format "~8,3F" 123.3456) +; => " 123.346" + (format "~6,3F" 123.3456) +; => "123.346" + (format "~2,3F" 123.3456) +; => "123.346" +(format "~8,3F" "foo") +; => " foo" +(format "~a~a~&" (list->string (list #\newline)) "") +; => +" +" +@end lisp +@end deffn + @node SRFI-55 @subsection SRFI-55 - Requiring Features @cindex SRFI-55 diff --git a/module/srfi/srfi-48.sld b/module/srfi/srfi-48.sld new file mode 100644 index 000000000..f488ca088 --- /dev/null +++ b/module/srfi/srfi-48.sld @@ -0,0 +1,14 @@ +;;;; SPDX-FileCopyrightText: 2014 Taylan Kammer +;;;; +;;;; SPDX-License-Identifier: MIT + +(define-library (srfi 48) + (export format) + (import (rename (scheme base) + (exact inexact->exact) + (inexact exact->inexact)) + (scheme char) + (scheme complex) + (rename (scheme write) + (write-shared write-with-shared-structure))) + (include "srfi-48/48.upstream.scm")) diff --git a/module/srfi/srfi-48/48.upstream.scm b/module/srfi/srfi-48/48.upstream.scm new file mode 100644 index 000000000..960d1a6b4 --- /dev/null +++ b/module/srfi/srfi-48/48.upstream.scm @@ -0,0 +1,409 @@ +;;; SPDX-FileCopyrightText: 2003 Kenneth A Dickey +;;; SPDX-FileCopyrightText: 2017 Hamayama +;;; +;;; SPDX-License-Identifier: MIT + +;; IMPLEMENTATION DEPENDENT options + +(define ascii-tab (integer->char 9)) ;; NB: assumes ASCII encoding +(define dont-print (if (eq? #t #f) 1)) +;;(define DONT-PRINT (string->symbol "")) +;;(define DONT-PRINT (void)) +;;(define DONT-PRINT #!void) +(define pretty-print write) ; ugly but permitted +;; (require 'srfi-38) ;; write-with-shared-structure + +;; Following three procedures are used by format ~F . +;; 'inexact-number->string' determines whether output is fixed-point +;; notation or exponential notation. In the current definition, +;; the notation depends on the implementation of 'number->string'. +;; 'exact-number->string' is expected to output only numeric characters +;; (not including such as '#', 'e', '.', '/') if the input is an positive +;; integer or zero. +;; 'real-number->string' is used when the digits of ~F is not specified. +(define (inexact-number->string x) (number->string (exact->inexact x))) +(define (exact-number->string x) (number->string (inexact->exact x))) +(define (real-number->string x) (number->string x)) + +;; FORMAT +(define (format . args) + (cond + ((null? args) + (error "FORMAT: required format-string argument is missing") + ) + ((string? (car args)) + (apply format (cons #f args))) + ((< (length args) 2) + (error (format #f "FORMAT: too few arguments ~s" (cons 'format args))) + ) + (else + (let ( (output-port (car args)) + (format-string (cadr args)) + (args (cddr args)) + ) + (letrec ( (port + (cond ((output-port? output-port) output-port) + ((eq? output-port #t) (current-output-port)) + ((eq? output-port #f) (open-output-string)) + (else (error + (format #f "FORMAT: bad output-port argument: ~s" + output-port))) + ) ) + (return-value + (if (eq? output-port #f) ;; if format into a string + (lambda () (get-output-string port)) ;; then return the string + (lambda () dont-print)) ;; else do something harmless + ) + ) + + (define (string-index str c) + (let ( (len (string-length str)) ) + (let loop ( (i 0) ) + (cond ((= i len) #f) + ((eqv? c (string-ref str i)) i) + (else (loop (+ i 1))))))) + + (define (string-grow str len char) + (let ( (off (- len (string-length str))) ) + (if (positive? off) + (string-append (make-string off char) str) + str))) + + (define (compose-with-digits digits pre-str frac-str exp-str) + (let ( (frac-len (string-length frac-str)) ) + (cond + ((< frac-len digits) ;; grow frac part, pad with zeros + (string-append pre-str "." + frac-str (make-string (- digits frac-len) #\0) + exp-str) + ) + ((= frac-len digits) ;; frac-part is exactly the right size + (string-append pre-str "." + frac-str + exp-str) + ) + (else ;; must round to shrink it + (let* ( (minus-flag (and (> (string-length pre-str) 0) + (char=? (string-ref pre-str 0) #\-))) + (pre-str* (if minus-flag + (substring pre-str 1 (string-length pre-str)) + pre-str)) + (first-part (substring frac-str 0 digits)) + (last-part (substring frac-str digits frac-len)) + (temp-str + (string-grow + (exact-number->string + (round (string->number + (string-append pre-str* first-part "." last-part)))) + digits + #\0)) + (temp-len (string-length temp-str)) + (new-pre (substring temp-str 0 (- temp-len digits))) + (new-frac (substring temp-str (- temp-len digits) temp-len)) + ) + (string-append + (if minus-flag "-" "") + (if (string=? new-pre "") + ;; check if the system displays integer part of numbers + ;; whose absolute value is 0 < x < 1. + (if (and (string=? pre-str* "") + (> digits 0) + (not (= (string->number new-frac) 0))) + "" "0") + new-pre) + "." + new-frac + exp-str))) + ) ) ) + + (define (format-fixed number-or-string width digits) ; returns a string + (cond + ((string? number-or-string) + (string-grow number-or-string width #\space) + ) + ((number? number-or-string) + (let ( (real (real-part number-or-string)) + (imag (imag-part number-or-string)) + ) + (cond + ((not (zero? imag)) + (string-grow + (string-append (format-fixed real 0 digits) + (if (negative? imag) "" "+") + (format-fixed imag 0 digits) + "i") + width + #\space) + ) + (digits + (let* ( (num-str (inexact-number->string real)) + (dot-index (string-index num-str #\.)) + (exp-index (string-index num-str #\e)) + (length (string-length num-str)) + (pre-string + (if dot-index + (substring num-str 0 dot-index) + (if exp-index + (substring num-str 0 exp-index) + num-str)) + ) + (exp-string + (if exp-index + (substring num-str exp-index length) + "") + ) + (frac-string + (if dot-index + (if exp-index + (substring num-str (+ dot-index 1) exp-index) + (substring num-str (+ dot-index 1) length)) + "") + ) + ) + ;; check +inf.0, -inf.0, +nan.0, -nan.0 + (if (string-index num-str #\n) + (string-grow num-str width #\space) + (string-grow + (compose-with-digits digits + pre-string + frac-string + exp-string) + width + #\space)) + )) + (else ;; no digits + (string-grow (real-number->string real) width #\space))) + )) + (else + (error + (format "FORMAT: ~F requires a number or a string, got ~s" number-or-string))) + )) + + (define documentation-string +"(format [] [...]) -- is #t, #f or an output-port +OPTION [MNEMONIC] DESCRIPTION -- Implementation Assumes ASCII Text Encoding +~H [Help] output this text +~A [Any] (display arg) for humans +~S [Slashified] (write arg) for parsers +~W [WriteCircular] like ~s but outputs circular and recursive data structures +~~ [tilde] output a tilde +~T [Tab] output a tab character +~% [Newline] output a newline character +~& [Freshline] output a newline character if the previous output was not a newline +~D [Decimal] the arg is a number which is output in decimal radix +~X [heXadecimal] the arg is a number which is output in hexdecimal radix +~O [Octal] the arg is a number which is output in octal radix +~B [Binary] the arg is a number which is output in binary radix +~w,dF [Fixed] the arg is a string or number which has width w and d digits after the decimal +~C [Character] charater arg is output by write-char +~_ [Space] a single space character is output +~Y [Yuppify] the list arg is pretty-printed to the output +~? [Indirection] recursive format: next 2 args are format-string and list of arguments +~K [Indirection] same as ~? +" + ) + + (define (require-an-arg args) + (if (null? args) + (error "FORMAT: too few arguments" )) + ) + + (define (format-help format-strg arglist) + + (letrec ( + (length-of-format-string (string-length format-strg)) + + (anychar-dispatch + (lambda (pos arglist last-was-newline) + (if (>= pos length-of-format-string) + arglist ; return unused args + (let ( (char (string-ref format-strg pos)) ) + (cond + ((eqv? char #\~) + (tilde-dispatch (+ pos 1) arglist last-was-newline)) + (else + (write-char char port) + (anychar-dispatch (+ pos 1) arglist #f) + )) + )) + )) ; end anychar-dispatch + + (has-newline? + (lambda (whatever last-was-newline) + (or (eqv? whatever #\newline) + (and (string? whatever) + (let ( (len (string-length whatever)) ) + (if (zero? len) + last-was-newline + (eqv? #\newline (string-ref whatever (- len 1))))))) + )) ; end has-newline? + + (tilde-dispatch + (lambda (pos arglist last-was-newline) + (cond + ((>= pos length-of-format-string) + (write-char #\~ port) ; tilde at end of string is just output + arglist ; return unused args + ) + (else + (case (char-upcase (string-ref format-strg pos)) + ((#\A) ; Any -- for humans + (require-an-arg arglist) + (let ( (whatever (car arglist)) ) + (display whatever port) + (anychar-dispatch (+ pos 1) + (cdr arglist) + (has-newline? whatever last-was-newline)) + )) + ((#\S) ; Slashified -- for parsers + (require-an-arg arglist) + (let ( (whatever (car arglist)) ) + (write whatever port) + (anychar-dispatch (+ pos 1) + (cdr arglist) + (has-newline? whatever last-was-newline)) + )) + ((#\W) + (require-an-arg arglist) + (let ( (whatever (car arglist)) ) + (write-with-shared-structure whatever port) ;; srfi-38 + (anychar-dispatch (+ pos 1) + (cdr arglist) + (has-newline? whatever last-was-newline)) + )) + ((#\D) ; Decimal + (require-an-arg arglist) + (display (number->string (car arglist) 10) port) + (anychar-dispatch (+ pos 1) (cdr arglist) #f) + ) + ((#\X) ; HeXadecimal + (require-an-arg arglist) + (display (number->string (car arglist) 16) port) + (anychar-dispatch (+ pos 1) (cdr arglist) #f) + ) + ((#\O) ; Octal + (require-an-arg arglist) + (display (number->string (car arglist) 8) port) + (anychar-dispatch (+ pos 1) (cdr arglist) #f) + ) + ((#\B) ; Binary + (require-an-arg arglist) + (display (number->string (car arglist) 2) port) + (anychar-dispatch (+ pos 1) (cdr arglist) #f) + ) + ((#\C) ; Character + (require-an-arg arglist) + (write-char (car arglist) port) + (anychar-dispatch (+ pos 1) (cdr arglist) (eqv? (car arglist) #\newline)) + ) + ((#\~) ; Tilde + (write-char #\~ port) + (anychar-dispatch (+ pos 1) arglist #f) + ) + ((#\%) ; Newline + (newline port) + (anychar-dispatch (+ pos 1) arglist #t) + ) + ((#\&) ; Freshline + (if (not last-was-newline) ;; (unless last-was-newline .. + (newline port)) + (anychar-dispatch (+ pos 1) arglist #t) + ) + ((#\_) ; Space + (write-char #\space port) + (anychar-dispatch (+ pos 1) arglist #f) + ) + ((#\T) ; Tab -- IMPLEMENTATION DEPENDENT ENCODING + (write-char ascii-tab port) + (anychar-dispatch (+ pos 1) arglist #f) + ) + ((#\Y) ; Pretty-print + (pretty-print (car arglist) port) ;; IMPLEMENTATION DEPENDENT + (anychar-dispatch (+ pos 1) (cdr arglist) #f) + ) + ((#\F) + (require-an-arg arglist) + (display (format-fixed (car arglist) 0 #f) port) + (anychar-dispatch (+ pos 1) (cdr arglist) #f) + ) + ((#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9) ;; gather "~w[,d]F" w and d digits + (let loop ( (index (+ pos 1)) + (w-digits (list (string-ref format-strg pos))) + (d-digits '()) + (in-width? #t) + ) + (if (>= index length-of-format-string) + (error + (format "FORMAT: improper numeric format directive in ~s" format-strg)) + (let ( (next-char (string-ref format-strg index)) ) + (cond + ((char-numeric? next-char) + (if in-width? + (loop (+ index 1) + (cons next-char w-digits) + d-digits + in-width?) + (loop (+ index 1) + w-digits + (cons next-char d-digits) + in-width?)) + ) + ((char=? (char-upcase next-char) #\F) + (let ( (width (string->number (list->string (reverse w-digits)))) + (digits (if (zero? (length d-digits)) + #f + (string->number (list->string (reverse d-digits))))) + ) + (display (format-fixed (car arglist) width digits) port) + (anychar-dispatch (+ index 1) (cdr arglist) #f)) + ) + ((char=? next-char #\,) + (if in-width? + (loop (+ index 1) + w-digits + d-digits + #f) + (error + (format "FORMAT: too many commas in directive ~s" format-strg))) + ) + (else + (error (format "FORMAT: ~~w.dF directive ill-formed in ~s" format-strg)))))) + )) + ((#\? #\K) ; indirection -- take next arg as format string + (cond ; and following arg as list of format args + ((< (length arglist) 2) + (error + (format "FORMAT: less arguments than specified for ~~?: ~s" arglist)) + ) + ((not (string? (car arglist))) + (error + (format "FORMAT: ~~? requires a string: ~s" (car arglist))) + ) + (else + (format-help (car arglist) (cadr arglist)) + (anychar-dispatch (+ pos 1) (cddr arglist) #f) + ))) + ((#\H) ; Help + (display documentation-string port) + (anychar-dispatch (+ pos 1) arglist #t) + ) + (else + (error (format "FORMAT: unknown tilde escape: ~s" + (string-ref format-strg pos)))) + ))) + )) ; end tilde-dispatch + ) ; end letrec + + ; format-help main + (anychar-dispatch 0 arglist #f) + )) ; end format-help + + ; format main + (let ( (unused-args (format-help format-string args)) ) + (if (not (null? unused-args)) + (error + (format "FORMAT: unused arguments ~s" unused-args))) + (return-value)) + + )) ; end letrec, if +))) ; end format diff --git a/test-suite/Makefile.am b/test-suite/Makefile.am index 2b5156923..612f6935c 100644 --- a/test-suite/Makefile.am +++ b/test-suite/Makefile.am @@ -153,6 +153,7 @@ SCM_TESTS = tests/00-initial-env.test \ tests/srfi-42.test \ tests/srfi-43.test \ tests/srfi-45.test \ + tests/srfi-48.test \ tests/srfi-60.test \ tests/srfi-64.test \ tests/srfi-67.test \ diff --git a/test-suite/tests/srfi-48.test b/test-suite/tests/srfi-48.test new file mode 100644 index 000000000..9d97a863d --- /dev/null +++ b/test-suite/tests/srfi-48.test @@ -0,0 +1,320 @@ +;;; SPDX-FileCopyrightText: 2017 Hamayama +;;; +;;; SPDX-License-Identifier: MIT + +;; +;; srfi-48 format test for Gauche, Sagittarius, Guile, Chez Scheme +;; + +;;; START Guile-specific modifications. +(use-modules (srfi srfi-48) + (test-suite lib)) + +(define-syntax-rule (test-start name) + #t) + +(define-syntax-rule (test-end) + #t) + +(define-syntax-rule (test-section name) + #t) + +(define-syntax expect + (syntax-rules () + ((_ expected result) + (pass-if (equal? expected result))) + ((_ expected result check) + (pass-if (check expected result))))) +;;; END Guile-specific modifications. + +(cond-expand + (gauche) + (else + (define (x->number x) + (cond + ((number? x) x) + ((string? x) (string->number x)) + (else (error "x->number error")))) + )) + +(define (nearly=? a b) + (let* ((a1 (x->number a)) + (b1 (x->number b)) + (e1 (abs (- a1 b1)))) + ;(format #t "(a1 = ~s, b1 = ~s, e1 = ~s)~%" a1 b1 e1) + (< e1 1.0e-10))) + +(define pi 3.141592653589793) + +(test-start "srfi-48 format test") + +(test-section "original") +(expect (format "test ~s" 'me) (format #f "test ~a" "me")) +(expect " 0.333" (format "~6,3F" 1/3)) ;;; " .333" OK +(expect " 12" (format "~4F" 12)) +(expect " 12.346" (format "~8,3F" 12.3456)) +(expect "123.346" (format "~6,3F" 123.3456)) +(expect "123.346" (format "~4,3F" 123.3456)) +(expect "0.000+1.949i" (format "~8,3F" (sqrt -3.8))) +(expect " 32.00" (format "~6,2F" 32)) +(expect " 32" (format "~6F" 32)) +;(expect " 32." (format "~6F" 32.)) ;; " 32.0" OK +(expect " 32.0" (format "~6F" 32.)) +;; NB: (not (and (exact? 32.) (integer? 32.))) +(expect " 3.2e46" (format "~8F" 32e45)) +(expect " 3.2e-44" (format "~8F" 32e-45)) +(expect " 3.2e21" (format "~8F" 32e20)) +;;(expect " 3.2e6" (format "~8F" 32e5)) ;; ok. converted in input to 3200000.0 +;(expect " 3200." (format "~8F" 32e2)) ;; " 3200.0" OK +(expect " 3200.0" (format "~8F" 32e2)) +(expect " 3.20e11" (format "~8,2F" 32e10)) +(expect " 1.2345" (format "~12F" 1.2345)) +(expect " 1.23" (format "~12,2F" 1.2345)) +(expect " 1.234" (format "~12,3F" 1.2345)) +(expect " 0.000+1.949i" (format "~20,3F" (sqrt -3.8))) +(expect "0.000+1.949i" (format "~8,3F" (sqrt -3.8))) +(expect " 3.46e11" (format "~8,2F" 3.4567e11)) +; (expect "#1=(a b c . #1#)" +; (format "~w" (let ( (c '(a b c)) ) (set-cdr! (cddr c) c) c))) +(expect " +" + (format "~A~A~&" (list->string (list #\newline)) "")) +(expect "a new test" + (format "~a ~? ~a" 'a "~s" '(new) 'test)) +(expect "a new test, yes!" + (format "~a ~?, ~a!" 'a "~s ~a" '(new test) 'yes)) +(expect " 3.46e20" (format "~8,2F" 3.4567e20)) +(expect " 3.46e21" (format "~8,2F" 3.4567e21)) +(expect " 3.46e22" (format "~8,2F" 3.4567e22)) +(expect " 3.46e23" (format "~8,2F" 3.4567e23)) +(expect " 3.e24" (format "~8,0F" 3.4567e24)) +(expect " 3.5e24" (format "~8,1F" 3.4567e24)) +(expect " 3.46e24" (format "~8,2F" 3.4567e24)) +(expect "3.457e24" (format "~8,3F" 3.4567e24)) +(expect " 4.e24" (format "~8,0F" 3.5567e24)) +(expect " 3.6e24" (format "~8,1F" 3.5567e24)) +(expect " 3.56e24" (format "~8,2F" 3.5567e24)) +(expect " -3.e-4" (format "~10,0F" -3e-4)) +(expect " -3.0e-4" (format "~10,1F" -3e-4)) +(expect " -3.00e-4" (format "~10,2F" -3e-4)) +(expect " -3.000e-4" (format "~10,3F" -3e-4)) +(expect "-3.0000e-4" (format "~10,4F" -3e-4)) +(expect "-3.00000e-4" (format "~10,5F" -3e-4)) +(expect " 1.020" (format "~10,3F" 1.02)) +(expect " 1.025" (format "~10,3F" 1.025)) +(expect " 1.026" (format "~10,3F" 1.0256)) +(expect " 1.002" (format "~10,3F" 1.002)) +(expect " 1.002" (format "~10,3F" 1.0025)) +(expect " 1.003" (format "~10,3F" 1.00256)) + + +(test-section "examples") +(expect " 0.33" (format "~8,2F" 1/3)) +(expect " 32" (format "~6F" 32)) +(expect " 32.00" (format "~8,2F" 32)) +(expect "4321.00" (format "~1,2F" 4321)) +(expect "0.00+1.97i" (format "~1,2F" (sqrt -3.9))) +(expect "3200000.0" (format "~8F" 32e5)) +;(expect " 3.2e6" (format "~8F" 32e5)) +(expect "" (format "~h") (lambda (e r) (string? r))) +(expect "Hello, World!" (format "Hello, ~a" "World!")) +(expect "Error, list is too short: (one \"two\" 3)" (format "Error, list is too short: ~s" '(one "two" 3))) +(expect "test me" (format "test me")) +(expect "this is a \"test\"" (format "~a ~s ~a ~s" 'this 'is "a" "test")) +(expect (if #f #f) (format #t "#d~d #x~x #o~o #b~b~%" 32 32 32 32)) +(expect "a new test" (format "~a ~? ~a" 'a "~s" '(new) 'test)) +(expect "\n1\n2\n3\n" (format #f "~&1~&~&2~&~&~&3~%")) +(expect "3 2 2 3 \n" (format #f "~a ~? ~a ~%" 3 " ~s ~s " '(2 2) 3)) +;; incorrect mutation of literal list in example +;(expect "#1=(a b c . #1#)" (format "~w" (let ( (c '(a b c)) ) (set-cdr! (cddr c) c) c))) +(cond-expand + (chezscheme) + (guile + (expect "#1=(a b c . #1#)" (format "~w" (let ( (c (list 'a 'b 'c)) ) (set-cdr! (cddr c) c) c))) + ) + (else + (expect "#0=(a b c . #0#)" (format "~w" (let ( (c (list 'a 'b 'c)) ) (set-cdr! (cddr c) c) c))) + )) +(expect " 32.00" (format "~8,2F" 32)) +(expect "0.000+1.949i" (format "~8,3F" (sqrt -3.8))) +;(expect " 3.45e11" (format "~8,2F" 3.4567e11)) +(expect " 3.46e11" (format "~8,2F" 3.4567e11)) +(expect " 0.333" (format "~6,3F" 1/3)) +(expect " 12" (format "~4F" 12)) +(expect " 123.346" (format "~8,3F" 123.3456)) +(expect "123.346" (format "~6,3F" 123.3456)) +(expect "123.346" (format "~2,3F" 123.3456)) +(expect " foo" (format "~8,3F" "foo")) +(expect "\n" (format "~a~a~&" (list->string (list #\newline)) "")) + + +(test-section "~F normal") +(expect "0" (format "~F" 0)) +(expect "1" (format "~F" 1)) +(expect "123" (format "~F" 123)) +(expect "0.456" (format "~F" 0.456)) +(expect "123.456" (format "~F" 123.456)) +(expect "-1" (format "~F" -1)) +(expect "-123" (format "~F" -123)) +(expect "-0.456" (format "~F" -0.456)) +(expect "-123.456" (format "~F" -123.456)) + + +(test-section "~F width") +(expect "123" (format "~0F" 123)) +(expect "123" (format "~1F" 123)) +(expect "123" (format "~2F" 123)) +(expect "123" (format "~3F" 123)) +(expect " 123" (format "~4F" 123)) +(expect " 123" (format "~5F" 123)) +(expect "-123" (format "~3F" -123)) +(expect "-123" (format "~4F" -123)) +(expect " -123" (format "~5F" -123)) +(expect " -123" (format "~6F" -123)) + + +(test-section "~F digits") +(expect "123." (format "~1,0F" 123)) +(expect "123.0" (format "~1,1F" 123)) +(expect "123.00" (format "~1,2F" 123)) +(expect "0.12" (format "~1,2F" 0.123)) +(expect "0.123" (format "~1,3F" 0.123)) +(expect "0.1230" (format "~1,4F" 0.123)) +(expect "-123." (format "~1,0F" -123)) +(expect "-123.0" (format "~1,1F" -123)) +(expect "-123.00" (format "~1,2F" -123)) +(expect "-0.12" (format "~1,2F" -0.123)) +(expect "-0.123" (format "~1,3F" -0.123)) +(expect "-0.1230" (format "~1,4F" -0.123)) + + +(test-section "~F rounding (banker's rounding)") +(expect "123." (format "~1,0F" 123.456)) +(expect "123.5" (format "~1,1F" 123.456)) +(expect "123.46" (format "~1,2F" 123.456)) +(expect "-123." (format "~1,0F" -123.456)) +(expect "-123.5" (format "~1,1F" -123.456)) +(expect "-123.46" (format "~1,2F" -123.456)) +(expect "123.0" (format "~1,1F" 123.05)) +(expect "123.2" (format "~1,1F" 123.15)) +(expect "124.0" (format "~1,1F" 123.95)) +(expect "-123.0" (format "~1,1F" -123.05)) +(expect "-123.2" (format "~1,1F" -123.15)) +(expect "-124.0" (format "~1,1F" -123.95)) +(expect "1000.00" (format "~1,2F" 999.995)) +(expect "-1000.00" (format "~1,2F" -999.995)) +(expect "1." (format "~1,0F" 1.49)) +(expect "2." (format "~1,0F" 1.5)) +(expect "2." (format "~1,0F" 1.51)) +(expect "2." (format "~1,0F" 2.49)) +(expect "2." (format "~1,0F" 2.5)) +(expect "3." (format "~1,0F" 2.51)) + + +(test-section "~F misc") +(expect "+inf.0" (format "~F" +inf.0)) +(expect "-inf.0" (format "~F" -inf.0)) +(expect "+nan.0" (format "~F" +nan.0)) +(expect "0.0" (format "~F" 0.0)) +(expect "-0.0" (format "~F" -0.0)) +(expect "+inf.0" (format "~1F" +inf.0)) +(expect "-inf.0" (format "~1F" -inf.0)) +(expect "+nan.0" (format "~1F" +nan.0)) +(expect "0.0" (format "~1F" 0.0)) +(expect "-0.0" (format "~1F" -0.0)) +(expect "+inf.0" (format "~1,0F" +inf.0)) +(expect "-inf.0" (format "~1,0F" -inf.0)) +(expect "+nan.0" (format "~1,0F" +nan.0)) +(expect "0." (format "~1,0F" 0.0)) +(expect "-0." (format "~1,0F" -0.0)) +(expect "+inf.0" (format "~1,1F" +inf.0)) +(expect "-inf.0" (format "~1,1F" -inf.0)) +(expect "+nan.0" (format "~1,1F" +nan.0)) +(expect "0.0" (format "~1,1F" 0.0)) +(expect "-0.0" (format "~1,1F" -0.0)) +(expect "31.41592653589793" (format "~F" (* pi 10))) +(expect "0.33333" (format "~1,5F" 1/3)) +(expect "-0.33333" (format "~1,5F" -1/3)) +(expect "0.142857142857" (format "~1,12F" 1/7)) +(expect "299999999.999999999" (format "~F" 299999999999999999/1000000000) nearly=?) +(expect "1.797693e308" (format "~F" 1.797693e308)) +(expect "1.797693e308" (format "~1F" 1.797693e308)) +(expect "2.e308" (format "~1,0F" 1.797693e308)) +(expect "1.8e308" (format "~1,1F" 1.797693e308)) +(expect "-1.797693e308" (format "~F" -1.797693e308)) +(expect "-1.797693e308" (format "~1F" -1.797693e308)) +(expect "-2.e308" (format "~1,0F" -1.797693e308)) +(expect "-1.8e308" (format "~1,1F" -1.797693e308)) +(expect "2.225074e-308" (format "~F" 2.225074e-308)) +(expect "5.02" (format "~1,2F" 5.015)) +(expect "6.00" (format "~1,2F" 5.999)) +(expect "123." (format "~1,0F" 123.00)) +(expect "0.1" (format "~F" .1)) +(expect "1" (format "~1f" 1)) ; lower case f +(expect "1.e100" (format "~1,0F" 1e100)) +(expect "1." (format "~1,0F" 1)) +(expect "0." (format "~1,0F" .1)) +(expect "0.0" (format "~1,1F" .01)) + + +(cond-expand + (guile) + (else + (test-section "~F error") + (expect "" (guard (e (else "")) (format "~-1F" 1))) + (expect "" (guard (e (else "")) (format "~1,-1F" 1))) + )) + + +(test-section "from mailing list 2004-05-27") +(expect "1.230e20" (format "~0,3F" 1.23e20)) +(expect "1.230e-20" (format "~0,3F" 1.23e-20)) + + +(test-section "from mailing list 2004-06-11") +(expect "3.457e15" (format "~8,3F" 3.4569e15)) +(expect " 3.457" (format "~8,3F" 3.4569)) +(expect " 3.46e15" (format "~8,2F" 3.456e15)) +(expect " 3.46" (format "~8,2F" 3.456)) + + +(test-section "from mailing list 2005-06-03") +(expect " -3.e-4" (format "~10,0F" -3e-4)) +(expect " -3.0e-4" (format "~10,1F" -3e-4)) +(expect " -3.00e-4" (format "~10,2F" -3e-4)) +(expect " -3.000e-4" (format "~10,3F" -3e-4)) +(expect "-3.0000e-4" (format "~10,4F" -3e-4)) +(expect " 3.0000e-5" (format "~10,4F" 3e-5)) + + +(test-section "from mailing list 2005-06-07") +(expect " 1.020" (format "~10,3F" 1.02)) +(expect " 1.025" (format "~10,3F" 1.025)) +(expect " 1.026" (format "~10,3F" 1.0256)) +(expect " 1.002" (format "~10,3F" 1.002)) +(expect " 1.002" (format "~10,3F" 1.0025)) +(expect " 1.003" (format "~10,3F" 1.00256)) + + +(test-section "from mailing list 2005-06-07") +(expect "1.000012" (format "~8,6F" 1.00001234)) + + +(test-section "from mailing list 2005-07-02") +(expect "abc\ndef\nghi\n" (format "abc~%~&def~&ghi~%")) +(expect "\ndef\nghi\n" (format "~&def~&ghi~%")) + + +(test-section "from mailing list 2017-10-11") +(expect " 1.00" (format "~7,2F" .997554209949891)) +(expect " 1.00" (format "~7,2F" .99755)) +(expect " 1.00" (format "~7,2F" .9975)) +(expect " 1.00" (format "~7,2F" .997)) +(expect " 0.99" (format "~7,2F" .99)) + + +(test-section "from mailing list 2017-10-13") +(expect " 18.00" (format "~7,2F" 18.0000000000008)) +(expect " -15." (format "~8,0F" -14.99995999999362)) + +(test-end) -- 2.41.0