Changeset 15682 in project


Ignore:
Timestamp:
08/31/09 23:29:19 (10 years ago)
Author:
kon
Message:

Parse errors are now failures. Added type checking for components. Made posix tz name be almost anything.

Location:
release/4/locale/trunk
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • release/4/locale/trunk/locale-components.scm

    r15643 r15682  
    55;;
    66;; - Components predicates are not fool-proof.
     7;;
     8;; - Argument checking is minimal!
    79;;
    810;; - Used selectors for *-components since it is assumed extra elements will be needed by
     
    5759;;; Locale Components Operations
    5860
    59 (define-inline (*locale-component-exists? al what)
    60   (%->boolean (assq what al)) )
    61 
    62 (define-inline (*locale-component-ref al what def)
    63         (let ((cell (assq what al)))
     61(define-inline (*locale-component-exists? loc lc what)
     62  (%->boolean (assq what lc)) )
     63
     64(define-inline (*locale-component-ref loc lc what def)
     65        (let ((cell (assq what lc)))
    6466                (if cell (cdr cell)
    6567        def ) ) )
     
    6769; Components argument cannot be null to effect in-place modification.
    6870
    69 (define (*set-locale-component! al what value)
    70   (if (null? al) (alist-cons what value al)
    71     (let ((cell (assq what al)))
     71(define (*set-locale-component! loc lc what value checker)
     72  (checker loc what value)
     73  (if (null? lc) (alist-cons what value lc)
     74    (let ((cell (assq what lc)))
    7275      (cond (cell (set-cdr! cell value))
    73             (else (set-cdr! (last-pair al) (list (cons what value)))))
    74       al ) ) )
    75 
    76 (define (*update-locale-components! lc kvs)
     76            (else (set-cdr! (last-pair lc) (list (cons what value)))))
     77      lc ) ) )
     78
     79(define (*update-locale-components! loc lc kvs checker)
    7780        (let loop ((kvs kvs))
    7881                (cond ((null? kvs) lc)
    7982                      (else
    80            (set! lc (*set-locale-component! lc (car kvs) (cadr kvs)))
    81            (loop (cddr kvs)) ) ) ) )
     83                        (set! lc (*set-locale-component! loc lc (car kvs) (cadr kvs) checker))
     84            (loop (cddr kvs)) ) ) ) )
    8285
    8386;;; Locale Components
    8487
    85 (define (make-empty-locale-components) '())
     88(define (check-locale-component loc what value)
     89  (check-symbol loc what 'key)
     90  (case what
     91    ((tag)
     92      (unless (symbol? value)
     93        (error loc (make-error-type-message 'tag) value)) )
     94    ((name)
     95      (unless (not (eq? (void) value))
     96        (error loc (make-error-type-message 'name) value)) )
     97    ((source)
     98      (unless (or (string? value)
     99                  (and (pair? value) (string? (car value))))
     100        (error loc (make-error-type-message 'source) value)) )
     101    ((locales)
     102      (unless (and (list? value) (every locale-components? value))
     103        (error loc (make-error-type-message 'locales) value)) )
     104    ((language)
     105      (unless (string? value)
     106        (error loc (make-error-type-message 'language) value)) )
     107    ((script)
     108      (unless (string? value)
     109        (error loc (make-error-type-message 'script) value)) )
     110    ((region)
     111      (unless (string? value)
     112        (error loc (make-error-type-message 'region) value)) )
     113    ((codeset)
     114      (unless (string? value)
     115        (error loc (make-error-type-message 'codeset) value)) )
     116    ((modifier)
     117      (unless (string? value)
     118        (error loc (make-error-type-message 'modifier) value)) )
     119    ; accept everything else
     120    (else ) ) )
     121
     122(define (make-empty-locale-components loc tag)
     123  (*set-locale-component! loc '() 'tag tag check-locale-component))
     124
     125(define (*make-locale-components loc nam src tag)
     126  (let ((lc (make-empty-locale-components loc tag)))
     127    (*set-locale-component! loc lc 'name nam check-locale-component)
     128    (*set-locale-component! loc lc 'source src check-locale-component)
     129    lc ) )
    86130
    87131(define (make-locale-components nam . args)
    88132  (let-optionals args ((src #f) (tag 'locale))
    89     (let ((lc (*set-locale-component! (make-empty-locale-components) 'tag tag)))
    90       (*set-locale-component! lc 'name nam)
    91       (*set-locale-component! lc 'source src)
    92       lc ) ) )
     133    (*make-locale-components 'make-locale-components nam src tag) ) )
    93134
    94135(define (locale-components? obj)
    95136        (and (pair? obj)
    96              (*locale-component-exists? obj 'tag)
    97              (*locale-component-exists? obj 'name)
    98              (*locale-component-exists? obj 'source)) )
     137             (*locale-component-exists? 'locale-components? obj 'tag)
     138             (*locale-component-exists? 'locale-components? obj 'name)
     139             (*locale-component-exists? 'locale-components? obj 'source)) )
    99140
    100141(define-check+error-type locale-components)
     
    102143(define (locale-component-exists? lc what)
    103144  (check-locale-components 'locale-component-exists? lc)
    104   (*locale-component-exists? lc what) )
     145  (*locale-component-exists? 'locale-component-exists? lc what) )
    105146
    106147(define (locale-component-ref lc what . def)
    107148  (check-locale-components 'locale-component-ref lc)
    108         (*locale-component-ref lc what (optional def #f)) )
     149        (*locale-component-ref 'locale-component-ref lc what (optional def #f)) )
    109150
    110151(define (set-locale-component! lc what value)
    111152  (check-locale-components 'set-locale-component! lc)
    112         (*set-locale-component! lc what value) )
     153        (*set-locale-component! 'set-locale-component! lc what value check-locale-component) )
    113154
    114155(define (update-locale-components! lc . args)
    115156  (check-locale-components 'update-locale-components! lc)
    116         (*update-locale-components! lc args) )
     157        (*update-locale-components! 'update-locale-components! lc args check-locale-component) )
    117158
    118159;;; Timezone Daylight Saving Time Rule
    119160
     161;; Offset
     162
     163(define-constant SEC/DY 86400)
     164(define (timezone-offset? obj) (and (fixnum? obj) (<= 0 (abs obj) SEC/DY)))
     165
     166(define-check+error-type timezone-offset)
     167
     168;;
     169
     170;The Julian day n (1 <= n <= 365).  Leap days are not counted; that is, in all
     171;years -- including leap years -- February 28 is day 59 and March 1 is day 60.
     172;It is impossible to explicitly refer to the occasional February 29.
     173
    120174(define-record-type timezone-dst-rule-julian-noleap
    121   (make-timezone-dst-rule-julian-noleap j o)
     175  (%make-timezone-dst-rule-julian-noleap j o)
    122176  timezone-dst-rule-julian-noleap?
    123177  (j timezone-dst-rule-julian-noleap-day)
    124178  (o timezone-dst-rule-julian-noleap-offset) )
    125179
     180(define (timezone-dst-rule-julian-noleap-day? obj) (and (fixnum? obj) (<= 1 obj 365)))
     181
     182(define-check+error-type timezone-dst-rule-julian-noleap-day)
     183
     184(define (make-timezone-dst-rule-julian-noleap j o)
     185  (check-timezone-dst-rule-julian-noleap-day 'make-timezone-dst-rule-julian-noleap j)
     186  (check-timezone-offset 'make-timezone-dst-rule-julian-noleap o)
     187  (%make-timezone-dst-rule-julian-noleap j o) )
     188
     189;;
     190
     191;The zero-based Julian day (0 <= n <= 365 ). Leap days are counted, and it is
     192;possible to refer to February 29.
     193
    126194(define-record-type timezone-dst-rule-julian-leap
    127   (make-timezone-dst-rule-julian-leap j o)
     195  (%make-timezone-dst-rule-julian-leap j o)
    128196  timezone-dst-rule-julian-leap?
    129197  (j timezone-dst-rule-julian-leap-day)
    130198  (o timezone-dst-rule-julian-leap-offset) )
    131199
     200(define (timezone-dst-rule-julian-leap-day? obj) (and (fixnum? obj) (<= 0 obj 365)))
     201
     202(define-check+error-type timezone-dst-rule-julian-leap-day)
     203
     204(define (make-timezone-dst-rule-julian-leap j o)
     205  (check-timezone-dst-rule-julian-leap-day 'make-timezone-dst-rule-julian-leap j)
     206  (check-timezone-offset 'make-timezone-dst-rule-julian-leap o)
     207  (%make-timezone-dst-rule-julian-leap j o) )
     208
     209;;
     210
     211(define (timezone-dst-rule-julian? r) (or (timezone-dst-rule-julian-noleap? r) (timezone-dst-rule-julian-leap? r)))
     212
     213(define-error-type timezone-dst-rule-julian)
     214
     215(define (timezone-dst-rule-julian r)
     216  (cond ((timezone-dst-rule-julian-noleap? r) (timezone-dst-rule-julian-noleap-day r))
     217        ((timezone-dst-rule-julian-leap? r) (timezone-dst-rule-julian-leap-day r))
     218        (else
     219         (error-timezone-dst-rule-julian 'timezone-dst-rule-julian r) ) ) )
     220
     221;;
     222
     223;The d'th day (0 <= d <= 6) of week n of month m of the year (1 <= n <= 5), (1
     224;<= m <= 12), where week 5 means ``the last d day in month m'' which may occur
     225;in either the fourth or the fifth week).  Week 1 is the first week in which the
     226;d'th day occurs.  Day zero is Sunday.
     227
    132228(define-record-type timezone-dst-rule-mwd
    133   (make-timezone-dst-rule-mwd m w d o)
     229  (%make-timezone-dst-rule-mwd m w d o)
    134230  timezone-dst-rule-mwd?
    135231  (m timezone-dst-rule-mwd-month)
     
    138234  (o timezone-dst-rule-mwd-offset) )
    139235
     236(define (timezone-dst-rule-mwd-day? obj) (and (fixnum? obj) (<= 0 obj 6)))
     237(define (timezone-dst-rule-mwd-week? obj) (and (fixnum? obj) (<= 1 obj 5)))
     238(define (timezone-dst-rule-mwd-month? obj) (and (fixnum? obj) (<= 1 obj 12)))
     239
     240(define-check+error-type timezone-dst-rule-mwd-day)
     241(define-check+error-type timezone-dst-rule-mwd-week)
     242(define-check+error-type timezone-dst-rule-mwd-month)
     243
    140244(define-check+error-type timezone-dst-rule-mwd)
    141 (define-error-type timezone-dst-rule-julian "timezone-dst-rule-julian")
    142 (define-error-type timezone-dst-rule "timezone-dst-rule")
    143 
    144 (define (timezone-dst-rule-julian? r)
    145   (or (timezone-dst-rule-julian-noleap? r) (timezone-dst-rule-julian-leap? r)) )
    146 
    147 (define (timezone-dst-rule-julian r)
    148   (cond ((timezone-dst-rule-julian-noleap? r) (timezone-dst-rule-julian-noleap-day r))
    149         ((timezone-dst-rule-julian-leap? r) (timezone-dst-rule-julian-leap-day r))
    150         (else
    151          (error-timezone-dst-rule-julian 'timezone-dst-rule-julian r) ) ) )
     245
     246(define (make-timezone-dst-rule-mwd m w d o)
     247  (check-timezone-dst-rule-mwd-month 'make-timezone-dst-rule-mwd m)
     248  (check-timezone-dst-rule-mwd-week 'make-timezone-dst-rule-mwd w)
     249  (check-timezone-dst-rule-mwd-day 'make-timezone-dst-rule-mwd d)
     250  (check-timezone-offset 'make-timezone-dst-rule-mwd o)
     251  (%make-timezone-dst-rule-mwd m w d o) )
    152252
    153253(define (timezone-dst-rule-month r)
     
    162262  (check-timezone-dst-rule-mwd 'timezone-dst-rule-day r)
    163263  (timezone-dst-rule-mwd-day r) )
     264
     265;;
     266
     267(define (timezone-dst-rule? obj)
     268  (or (timezone-dst-rule-julian-noleap? obj)
     269      (timezone-dst-rule-julian-leap? obj)
     270      (timezone-dst-rule-mwd? obj) ) )
     271
     272(define-error-type timezone-dst-rule)
    164273
    165274(define (timezone-dst-rule-offset r)
     
    172281;;; Timezone Components
    173282
     283(define (check-timezone-component loc what value)
     284  (check-symbol loc what 'key)
     285  (case what
     286    ((std-name)
     287      (unless (string? value)
     288        (error loc (make-error-type-message 'std-name) value)) )
     289    ((std-offset)
     290      (unless (timezone-offset? value)
     291        (error loc (make-error-type-message 'std-offset) value)) )
     292    ((dst-name)
     293      (unless (string? value)
     294        (error loc (make-error-type-message 'dst-name) value)) )
     295    ((dst-offset)
     296      (unless (timezone-offset? value)
     297        (error loc (make-error-type-message 'dst-offset) value)) )
     298    ((dst-start)
     299      (unless (timezone-dst-rule? value)
     300        (error loc (make-error-type-message 'dst-start) value)) )
     301    ((dst-end)
     302      (unless (timezone-dst-rule? value)
     303        (error loc (make-error-type-message 'dst-end) value)) )
     304    ; accept everything else
     305    (else ) ) )
     306
    174307(define (make-timezone-components nam . src)
    175   (make-locale-components nam (optional src #f) 'timezone) )
     308  (*make-locale-components 'make-timezone-components nam (optional src #f) 'timezone) )
    176309
    177310(define (timezone-components? obj)
    178311        (and (locale-components? obj)
    179              (eq? 'timezone (*locale-component-ref obj 'tag #f))) )
     312             (eq? 'timezone (*locale-component-ref 'timezone-components? obj 'tag #f))) )
    180313
    181314(define-check+error-type timezone-components)
     
    183316(define (timezone-component-ref tz what . def)
    184317  (check-timezone-components 'timezone-component-ref tz)
    185         (*locale-component-ref tz what (optional def #f)) )
     318        (*locale-component-ref 'timezone-component-ref tz what (optional def #f)) )
    186319
    187320(define (set-timezone-component! tz what value)
    188321  (check-timezone-components 'set-timezone-component! tz)
    189         (*set-locale-component! tz what value) )
     322        (*set-locale-component! 'set-timezone-component!  tz what value check-timezone-component) )
    190323
    191324(define (update-timezone-components! tz . args)
    192325  (check-timezone-components 'update-timezone-components! tz)
    193         (*update-locale-components! tz args) )
     326        (*update-locale-components! 'update-timezone-components! tz args check-timezone-component) )
    194327
    195328) ;module locale-components
  • release/4/locale/trunk/locale-current.scm

    r15643 r15682  
    7676;;;
    7777
    78 ;; Use posix locale system, for now
     78;; Use Posix locale system
    7979
    80 (posix-load-timezone)
    81 (posix-load-locale)
    82 (gnu-load-locale)
     80(unless (current-timezone) (posix-load-timezone))
     81(unless (current-locale) (posix-load-locale))
     82(unless (locale-category-ref 'language) (gnu-load-locale))
    8383
    84 ;; Need the current-timezone-components, and unless we
    85 ;; have a current-timezone need to fake one from system
    86 ;; time info.
     84;; Use Builtin (fake) locale system
    8785
    8886(unless (current-timezone) (use-builtin-timezone))
     
    9088(unless (locale-category-ref 'language) (use-builtin-language))
    9189
    92 ;; Chicken platform
     90;; Chicken platform extensions
    9391
    94 (unless (current-timezone-components) (error 'locale "cannot determine any timezone"))
    95 (set-timezone-component! (current-timezone-components) 'dst? (%current-dstflag))
     92(when (current-timezone-components)
     93  (set-timezone-component! (current-timezone-components) 'dst? (%current-dstflag)) )
     94
     95;; We really should have something by now
     96
     97(unless (current-timezone-components) (warning "cannot determine a timezone") )
     98(unless (current-locale-components) (warning "cannot determine a locale") )
    9699
    97100) ;module locale
  • release/4/locale/trunk/locale-posix.scm

    r15661 r15682  
    6868
    6969(define parse-posix-literal-timezone
    70         (let ((name-re (regexp "(^[A-Za-z]+)|^<([^>]+)>"))
     70        (let ((name-re (regexp "(^[^<:][^0-9,+-]+)|^<([^>]+)>"))
    7171                                (offset-re (regexp "^(\\+|-)?([0-9]+)(:[0-9]+)?(:[0-9]+)?"))
    7272                                ; For compatibility with System V Release 3.1, a semicolon (`;') may be
    7373                                ; used to separate the rule from the rest of the specification.
    7474                                ; Allow it to separate the "to DST" & "from DST" segments since no harm, no foul.
    75                                 (date-re (regexp "^[;,]([JM]?)([0-9]+)(\\.[0-9]+)?(\\.[0-9]+)?"))
     75                                (date-re (regexp "^[;,]([JM])?([0-9]+)(\\.[0-9]+)?(\\.[0-9]+)?"))
    7676                                (time-re (regexp "^/([0-9]+)(:[0-9]+)?(:[0-9]+)?"))
    7777                                (+0200hrs+ (* 2 SEC/HR)) )
     
    8080            (strend (string-length str)) )
    8181        (letrec (
    82             (failwarn
    83               (lambda (msg) (warning msg str) #f) )
     82            (fail
     83              (lambda (msg)
     84                (error 'parse-posix-literal-timezone msg str) ) )
    8485            (next-match
    8586              (lambda (re)
     
    9091              (lambda ()
    9192                (or (<= strend strpos)
    92                     (failwarn "bad Posix timezone format") ) ) )
     93                    (fail "bad timezone format") ) ) )
    9394            (parse-number
    9495              (lambda (numstr)
     
    9697                      ((char-numeric? (string-ref numstr 0)) (string->number numstr) )
    9798                      (else
    98                         (failwarn "bad Posix timezone number") ) ) ) )
     99                        (fail "bad timezone number") ) ) ) )
    99100            (parse-delmcomp
    100101              (lambda (numstr delm)
    101102                (parse-number
    102                   (cond ((string-prefix? delm numstr) (string-trim numstr (string-ref delm 0)) )
    103                         (else                         numstr ) ) ) ) )
     103                  (if (not (and numstr (string-prefix? delm numstr))) numstr
     104                      (string-trim numstr (string-ref delm 0)) ) ) ) )
    104105            (parse-timecomp
    105               (lambda (numstr) (parse-delmcomp numstr ":")) )
    106             (parse-optional-timecomp  ; an offset component is optional
    107               (lambda (numstr) (if numstr (parse-timecomp numstr) 0)) )
     106              (lambda (numstr)
     107                (parse-delmcomp numstr ":")) )
    108108            (parse-daterulecomp
    109               (lambda (numstr) (parse-delmcomp numstr ".")) )
     109              (lambda (numstr)
     110                (parse-delmcomp numstr ".")) )
    110111            (hms->offset
    111112              (lambda (sgnstr hms-lst)
    112113                (and-let* ((hr (parse-number (car hms-lst)))
    113                            (mn (parse-optional-timecomp (cadr hms-lst)))
    114                            (sc (parse-optional-timecomp (caddr hms-lst))) )
     114                           (mn (parse-timecomp (cadr hms-lst)))
     115                           (sc (parse-timecomp (caddr hms-lst))) )
    115116                  (let ((secs (+ (* hr SEC/HR) (* mn SEC/MIN) sc)))
    116117                    (if (and sgnstr (string=? sgnstr "-")) (- secs) secs)) ) ) )
     
    119120                ; Must begin w/ a valid integer. Interpreted later.
    120121                (and-let* ((n1 (parse-number (car dat-lst))))
    121                   (if (not rulstr)
    122                       ; then assume Julian style rule
    123                       (make-timezone-dst-rule-julian-leap n1 off)
    124                       ; else select rule kind & interpret rest of match
    125                       (let ((rch (string-ref rulstr 0)))
    126                         (case rch
    127                           ((#\J)  ; Julian
     122                  (cond ((not rulstr) ;Julian Leap rule
     123                          (make-timezone-dst-rule-julian-leap n1 off) )
     124                      ; select rule kind & interpret rest of match
     125                      (else
     126                        (case (string-ref rulstr 0)
     127                          ((#\J)  ; Julian No-Leap rule
    128128                            (make-timezone-dst-rule-julian-noleap n1 off) )
    129129                          ((#\M)  ; Date
     
    132132                              (make-timezone-dst-rule-mwd n1 n d off) ) )
    133133                          (else
    134                             (failwarn "unknown Posix timezone DST rule type") ) ) ) ) ) ) )
     134                            (fail "unknown timezone DST rule type") ) ) ) ) ) ) )
    135135            (parse-dst-rule
    136136              (lambda (key)
     
    160160                ; Must have name & offset components
    161161                (let ((n-m (next-match name-re)))
    162                   (cond ((not n-m) (failwarn "bad Posix timezone STD name") )
     162                  (cond ((not n-m) (fail "bad timezone STD name") )
    163163                        (else
    164164                          (let ((o-m (next-match offset-re)))
    165                             (cond ((not o-m) (failwarn "bad Posix timezone STD offset") )
     165                            (cond ((not o-m) (fail "bad timezone STD offset") )
    166166                                  (else
    167167                                    (set-timezone-component! tz 'std-name (cadr n-m))
     
    169169                                    #t ) ) ) ) ) ) ) ) )
    170170          ; Walk the match set
    171           (cond ((string-null? str) (failwarn "empty Posix timezone") )
     171          (cond ((string-null? str) (fail "empty timezone") )
    172172                (else
    173173                 (and (std-parse)   ; Required
     
    209209(define (posix-timezone-string->timezone-components str . src)
    210210  (let ((tz (make-timezone-components str (optional src "POSIX"))))
    211     (cond ((string-prefix? ":" str)
     211    (cond ((and (string? str) (string-prefix? ":" str))
    212212            (parse-posix-implementation-defined-timezone tz str) )
     213          ((or (not (string? str)) (string=? "" str))
     214            #f )
    213215          (else
    214216            (parse-posix-literal-timezone tz str) ) ) ) )
     
    284286  (let-optionals args ((src "POSIX") (tag 'locale))
    285287    (let ((lc (make-locale-components str src tag)))
    286       (cond ((or (string=? str "C") (string=? str "POSIX"))
    287              ;FIXME - #f so BUILTIN source used but ...
    288              #f )
     288      (cond ((or (not (string? str)) (string=? "" str))
     289              #f )
     290            ((or (string=? str "C") (string=? str "POSIX"))
     291              ;FIXME - #f so BUILTIN source used but ...
     292              #f )
    289293            (else
    290              (parse-posix-literal-locale lc str) ) ) ) ) )
     294              (parse-posix-literal-locale lc str) ) ) ) ) )
    291295
    292296;;; The POSIX/GNU locale categories
     
    316320
    317321(define (gnu-language-string->locale-components str . args)
    318   (let-optionals args ((src "GNU") (tag 'language))
    319     (let* ((lc (make-locale-components str src tag))
    320            (lang (string-upcase (locale-component-ref lc 'language))))
    321       (update-locale-components! lc 'locales
    322        (map
    323         (lambda (str)
    324           (let ((rlc (posix-locale-string->locale-components str src)))
    325             (set-locale-component! rlc 'region lang)
    326             rlc ) )
    327         (string-split str ":")))
    328       lc ) ) )
     322  (and (string? str)
     323       (not (string=? "" str))
     324       (let-optionals args ((src "GNU") (tag 'language))
     325         (let* ((lc (make-locale-components str src tag))
     326                (lang (string-upcase (locale-component-ref lc 'language))))
     327           (update-locale-components! lc 'locales
     328            (map
     329             (lambda (str)
     330               (let ((rlc (posix-locale-string->locale-components str src)))
     331                 (set-locale-component! rlc 'region lang)
     332                 rlc ) )
     333             (string-split str ":")))
     334           lc ) ) ) )
    329335
    330336;;;
  • release/4/locale/trunk/tests/run.scm

    r15661 r15682  
    88        (test-group "Posix Timezone"
    99
    10     (test-assert "F1" (not (posix-timezone-string->timezone-components ":foo,bar,baz")))
    11     (test-assert "F2" (not (posix-timezone-string->timezone-components "23,foo")))
    12     (test-assert "F3" (not (posix-timezone-string->timezone-components "foo/23")))
    13     (test-assert "F4" (not (posix-timezone-string->timezone-components "foo-23bar/23")))
    14     (test-assert "F5" (not (posix-timezone-string->timezone-components "foo-23bar-22/23")))
     10    ; unsupported but not an error
     11    (test-assert "T1" (not (posix-timezone-string->timezone-components ":foo,bar,baz")))
     12
     13    ; cannot have a name composed of digits
     14    (test-error "T2" (posix-timezone-string->timezone-components "23,foo"))
     15 
     16    ; this is actually legal!
     17    (test-assert "T3" (posix-timezone-string->timezone-components "foo/23"))
     18
     19    ; this is actually legal!
     20                (test-assert "T4" (posix-timezone-string->timezone-components "foo-23bar/23"))
     21
     22    ; the dst section is bad
     23    (test-error "T5" (posix-timezone-string->timezone-components "foo-23bar-22/23"))
    1524
    1625          (let ((tz0 (make-timezone-components "PST+8:00" "TEST"))
    17           (tz1 (make-timezone-components "PST+8:00PDT+7:00:00" '("POSIX" "TZ")))
     26          (tz1 (make-timezone-components "PST+8:00PDT+7:00:00,M4.1.0,M10.5" '("POSIX" "TZ")))
    1827          (tz2 (make-timezone-components "PST+8:00PDT7,J23/12:34,34/1:00:01" "TEST")) )
    1928
     
    2130        (update-timezone-components! tz0
    2231          'std-name "PST" 'std-offset (* 8 60 60)))
    23       (test "S1" tz0
     32      (test "TS1" tz0
    2433        (posix-timezone-string->timezone-components "PST+8:00" "TEST"))
    2534
     
    2837          'std-name "PST" 'std-offset (* 8 60 60)
    2938          'dst-name "PDT" 'dst-offset (* 7 60 60)
    30           'dst-start (make-timezone-dst-rule-mwd 4 1 0 3600)
    31           'dst-end (make-timezone-dst-rule-mwd 10 5 0 3600)))
    32       (test "S2" tz1
     39          'dst-start (make-timezone-dst-rule-mwd 4 1 0 (* 2 60 60))
     40          'dst-end (make-timezone-dst-rule-mwd 10 5 0 (* 2 60 60))))
     41      (test "TS2" tz1
    3342        (posix-timezone-string->timezone-components "PST+8:00PDT+7:00:00,M4.1.0,M10.5" '("POSIX" "TZ")))
    3443
     
    3948          'dst-start (make-timezone-dst-rule-julian-noleap 23 (+ (* 12 60 60) (* 34 60)))
    4049          'dst-end (make-timezone-dst-rule-julian-leap 34 (+ (* 1 60 60) 1))))
    41       (test "S3" tz2
     50      (test "TS3" tz2
    4251        (posix-timezone-string->timezone-components "PST+8:00PDT7,J23/12:34,34/1:00:01" "TEST"))
    4352
    4453      (setenv "TZ" "PST+8:00PDT+7:00:00,M4.1.0,M10.5")
    4554      (posix-load-timezone)
    46       (test "S4" tz1 (current-timezone-components)) )
     55      (test "TS4" tz1 (current-timezone-components)) )
    4756        )
    4857
     
    6473          'modifier "foo,bar,baz"))
    6574
    66       (test-assert "F1" (not (posix-locale-string->locale-components "/foo,bar,baz" "TEST")))
    67       (test-assert "F2" (not (posix-locale-string->locale-components "23,bar,baz" "TEST")))
    68       (test-assert "F3" (not (posix-locale-string->locale-components "foo-bar_1" "TEST")))
     75      (test-assert "L1" (not (posix-locale-string->locale-components "/foo,bar,baz" "TEST")))
     76      (test-assert "L2" (not (posix-locale-string->locale-components "23,bar,baz" "TEST")))
     77      (test-assert "L3" (not (posix-locale-string->locale-components "foo-bar_1" "TEST")))
    6978
    70       (test "S1" lc0 (posix-locale-string->locale-components "en_US" '("POSIX" "LANG")))
    71       (test "S2" lc1 (posix-locale-string->locale-components "en-Latn_US.UTF8@foo,bar,baz" "TEST"))
     79      (test "LS1" lc0 (posix-locale-string->locale-components "en_US" '("POSIX" "LANG")))
     80      (test "LS2" lc1 (posix-locale-string->locale-components "en-Latn_US.UTF8@foo,bar,baz" "TEST"))
    7281
    7382      (setenv "LANG" "en_US")
    7483      (posix-load-locale)
    75       (test "S3" lc0 (current-locale-components))
    76       (test "S4" lc0 (locale-category-ref 'monetary)) )
     84      (test "LS3" lc0 (current-locale-components))
     85      (test "LS4" lc0 (locale-category-ref 'monetary)) )
    7786        )
    7887
Note: See TracChangeset for help on using the changeset viewer.