artemist/mes
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

mes: string->number: Support #x-prefixed hex numbers.

Browse source 
* mes/module/mes/scm.mes (string->number): Support "#x"-prefix.
* tests/math.test ("string->number #hex"): Test it.
This commit is contained in:
Jan Nieuwenhuizen 2019-08-02 22:52:46 +02:00
parent 26891251a6
commit dd34569751
No known key found for this signature in database
GPG key ID: F3C1A0D9C1D65273
2 changed files with 31 additions and 29 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
mes/module/mes/scm.mes
View file

@ -229,6 +229,7 @@
(equal? (substring string (- length suffix-length)) suffix)))) (equal? (substring string (- length suffix-length)) suffix))))
(define (string->number s . rest) (define (string->number s . rest)
(if (string-prefix? "#x" s) (string->number (string-drop s 2) 16)
(let ((lst (string->list s))) (let ((lst (string->list s)))
(and (pair? lst) (and (pair? lst)
(let* ((radix (if (null? rest) 10 (car rest))) (let* ((radix (if (null? rest) 10 (car rest)))
@ -256,7 +257,7 @@
(if (null? fraction) n (if (null? fraction) n
(let ((fraction ((compose string->number list->string) fraction))) (let ((fraction ((compose string->number list->string) fraction)))
(and fraction n))))) ; FLOAT as integer (and fraction n))))) ; FLOAT as integer
(else #f))))))))) (else #f))))))))))
(define inexact->exact identity) (define inexact->exact identity)

3
tests/math.test
View file

@ -6,7 +6,7 @@ exec ${MES-src/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests
;;; -*-scheme-*- ;;; -*-scheme-*-
;;; GNU Mes --- Maxwell Equations of Software ;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 2016,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org> ;;; Copyright © 2016,2018,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
;;; ;;;
;;; This file is part of GNU Mes. ;;; This file is part of GNU Mes.
;;; ;;;
@ -30,6 +30,7 @@ exec ${MES-src/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests
(mes-use-module (mes test)) (mes-use-module (mes test))
(pass-if-equal "string->number" 42 (string->number "42")) (pass-if-equal "string->number" 42 (string->number "42"))
(pass-if-equal "string->number neg" -42 (string->number "-42")) (pass-if-equal "string->number neg" -42 (string->number "-42"))
(pass-if-equal "string->number #hex" 170 (string->number "#xaa"))
(pass-if-not "string->number hex" (string->number "aa")) (pass-if-not "string->number hex" (string->number "aa"))
(pass-if-equal "string->number hex" 170 (string->number "aa" 16)) (pass-if-equal "string->number hex" 170 (string->number "aa" 16))
(pass-if-equal "string->number float" 1 (inexact->exact (string->number "1.0"))) (pass-if-equal "string->number float" 1 (inexact->exact (string->number "1.0")))