mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

Fix unbound variable references in `srfi-19.scm'.

Browse source 
* module/srfi/srfi-19.scm: Use `(ice-9 rdelim)'.
  (date->broken-down-time, priv:year-day, priv:char->int): Fix typo.
  (time-*->time-*, time-*->time-*!): Fix reference to unbound variable
  `caller'.
This commit is contained in:
Ludovic Courtès 2009-10-26 19:03:26 +01:00
parent 84a54b292d
commit ef171ff039
1 changed files with 23 additions and 14 deletions
Download patch file Download diff file Expand all files Collapse all files

37
srfi/srfi-19.scm
View file

@ -1,6 +1,6 @@
;;; srfi-19.scm --- Time/Date Library ;;; srfi-19.scm --- Time/Date Library
;; Copyright (C) 2001, 2002, 2003, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. ;; Copyright (C) 2001, 2002, 2003, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
;; ;;
;; This library is free software; you can redistribute it and/or ;; This library is free software; you can redistribute it and/or
;; modify it under the terms of the GNU Lesser General Public ;; modify it under the terms of the GNU Lesser General Public
@ -41,7 +41,8 @@
(define-module (srfi srfi-19) (define-module (srfi srfi-19)
:use-module (srfi srfi-6) :use-module (srfi srfi-6)
:use-module (srfi srfi-8) :use-module (srfi srfi-8)
:use-module (srfi srfi-9)) :use-module (srfi srfi-9)
:autoload (ice-9 rdelim) (read-line))
(begin-deprecated (begin-deprecated
;; Prevent `export' from re-exporting core bindings. This behaviour ;; Prevent `export' from re-exporting core bindings. This behaviour
@ -339,7 +340,7 @@
(set-tm:hour result (date-hour date)) (set-tm:hour result (date-hour date))
;; FIXME: SRFI day ranges from 0-31. (not compatible with set-tm:mday). ;; FIXME: SRFI day ranges from 0-31. (not compatible with set-tm:mday).
(set-tm:mday result (date-day date)) (set-tm:mday result (date-day date))
(set-tm:month result (- (date-month date) 1)) (set-tm:mon result (- (date-month date) 1))
;; FIXME: need to signal error on range violation. ;; FIXME: need to signal error on range violation.
(set-tm:year result (+ 1900 (date-year date))) (set-tm:year result (+ 1900 (date-year date)))
(set-tm:isdst result -1) (set-tm:isdst result -1)
@ -528,33 +529,38 @@
;; -- these depend on time-monotonic having the same definition as time-tai! ;; -- these depend on time-monotonic having the same definition as time-tai!
(define (time-monotonic->time-utc time-in) (define (time-monotonic->time-utc time-in)
(if (not (eq? (time-type time-in) time-monotonic)) (if (not (eq? (time-type time-in) time-monotonic))
(priv:time-error caller 'incompatible-time-types time-in)) (priv:time-error 'time-monotonic->time-utc
'incompatible-time-types time-in))
(let ((ntime (copy-time time-in))) (let ((ntime (copy-time time-in)))
(set-time-type! ntime time-tai) (set-time-type! ntime time-tai)
(priv:time-tai->time-utc! ntime ntime 'time-monotonic->time-utc))) (priv:time-tai->time-utc! ntime ntime 'time-monotonic->time-utc)))
(define (time-monotonic->time-utc! time-in) (define (time-monotonic->time-utc! time-in)
(if (not (eq? (time-type time-in) time-monotonic)) (if (not (eq? (time-type time-in) time-monotonic))
(priv:time-error caller 'incompatible-time-types time-in)) (priv:time-error 'time-monotonic->time-utc!
'incompatible-time-types time-in))
(set-time-type! time-in time-tai) (set-time-type! time-in time-tai)
(priv:time-tai->time-utc! ntime ntime 'time-monotonic->time-utc)) (priv:time-tai->time-utc! time-in time-in 'time-monotonic->time-utc))
(define (time-monotonic->time-tai time-in) (define (time-monotonic->time-tai time-in)
(if (not (eq? (time-type time-in) time-monotonic)) (if (not (eq? (time-type time-in) time-monotonic))
(priv:time-error caller 'incompatible-time-types time-in)) (priv:time-error 'time-monotonic->time-tai
'incompatible-time-types time-in))
(let ((ntime (copy-time time-in))) (let ((ntime (copy-time time-in)))
(set-time-type! ntime time-tai) (set-time-type! ntime time-tai)
ntime)) ntime))
(define (time-monotonic->time-tai! time-in) (define (time-monotonic->time-tai! time-in)
(if (not (eq? (time-type time-in) time-monotonic)) (if (not (eq? (time-type time-in) time-monotonic))
(priv:time-error caller 'incompatible-time-types time-in)) (priv:time-error 'time-monotonic->time-tai!
'incompatible-time-types time-in))
(set-time-type! time-in time-tai) (set-time-type! time-in time-tai)
time-in) time-in)
(define (time-utc->time-monotonic time-in) (define (time-utc->time-monotonic time-in)
(if (not (eq? (time-type time-in) time-utc)) (if (not (eq? (time-type time-in) time-utc))
(priv:time-error caller 'incompatible-time-types time-in)) (priv:time-error 'time-utc->time-monotonic
'incompatible-time-types time-in))
(let ((ntime (priv:time-utc->time-tai! time-in (make-time-unnormalized #f #f #f) (let ((ntime (priv:time-utc->time-tai! time-in (make-time-unnormalized #f #f #f)
'time-utc->time-monotonic))) 'time-utc->time-monotonic)))
(set-time-type! ntime time-monotonic) (set-time-type! ntime time-monotonic)
@ -562,7 +568,8 @@
(define (time-utc->time-monotonic! time-in) (define (time-utc->time-monotonic! time-in)
(if (not (eq? (time-type time-in) time-utc)) (if (not (eq? (time-type time-in) time-utc))
(priv:time-error caller 'incompatible-time-types time-in)) (priv:time-error 'time-utc->time-monotonic!
'incompatible-time-types time-in))
(let ((ntime (priv:time-utc->time-tai! time-in time-in (let ((ntime (priv:time-utc->time-tai! time-in time-in
'time-utc->time-monotonic!))) 'time-utc->time-monotonic!)))
(set-time-type! ntime time-monotonic) (set-time-type! ntime time-monotonic)
@ -570,14 +577,16 @@
(define (time-tai->time-monotonic time-in) (define (time-tai->time-monotonic time-in)
(if (not (eq? (time-type time-in) time-tai)) (if (not (eq? (time-type time-in) time-tai))
(priv:time-error caller 'incompatible-time-types time-in)) (priv:time-error 'time-tai->time-monotonic
'incompatible-time-types time-in))
(let ((ntime (copy-time time-in))) (let ((ntime (copy-time time-in)))
(set-time-type! ntime time-monotonic) (set-time-type! ntime time-monotonic)
ntime)) ntime))
(define (time-tai->time-monotonic! time-in) (define (time-tai->time-monotonic! time-in)
(if (not (eq? (time-type time-in) time-tai)) (if (not (eq? (time-type time-in) time-tai))
(priv:time-error caller 'incompatible-time-types time-in)) (priv:time-error 'time-tai->time-monotonic!
'incompatible-time-types time-in))
(set-time-type! time-in time-monotonic) (set-time-type! time-in time-monotonic)
time-in) time-in)
@ -780,7 +789,7 @@
(define (priv:year-day day month year) (define (priv:year-day day month year)
(let ((days-pr (assoc month priv:month-assoc))) (let ((days-pr (assoc month priv:month-assoc)))
(if (not days-pr) (if (not days-pr)
(priv:error 'date-year-day 'invalid-month-specification month)) (priv:time-error 'date-year-day 'invalid-month-specification month))
(if (and (priv:leap-year? year) (> month 2)) (if (and (priv:leap-year? year) (> month 2))
(+ day (cdr days-pr) 1) (+ day (cdr days-pr) 1)
(+ day (cdr days-pr))))) (+ day (cdr days-pr)))))
@ -1263,7 +1272,7 @@
((#\8) 8) ((#\8) 8)
((#\9) 9) ((#\9) 9)
(else (priv:time-error 'bad-date-template-string (else (priv:time-error 'bad-date-template-string
(list "Non-integer character" ch i))))) (list "Non-integer character" ch)))))
;; read an integer upto n characters long on port; upto -> #f is any length ;; read an integer upto n characters long on port; upto -> #f is any length
(define (priv:integer-reader upto port) (define (priv:integer-reader upto port)