Changeset 31045 in project


Ignore:
Timestamp:
06/17/14 20:58:13 (5 years ago)
Author:
evhan
Message:

r7rs/read: #![no-]fold-case, check read's argument type

Location:
release/4/r7rs/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • release/4/r7rs/trunk/scheme.read.scm

    r30900 r31045  
    11(module scheme.read (read)
    22  (import (except scheme read)
    3           (only chicken : current-read-table fx+ fx= optional unless when))
     3          (only chicken : current-read-table fx+ fx= optional unless when)
     4          (only chicken case-sensitive define-constant define-inline parameterize))
     5
     6  ;;;
     7  ;;; 2.1 Identifiers
     8  ;;;
     9
     10  ;; XXX Slot 14 indicates whether or not a port is case-folded.
     11  ;; Hopefully this doesn't interfere with anything else.
     12
     13  (define-constant port-fold-case-slot 14)
     14
     15  (define-inline (port-fold-case p)
     16    (##sys#slot p port-fold-case-slot))
     17
     18  (##sys#set-read-mark!
     19   'fold-case
     20   (lambda (p)
     21     (##sys#setslot p port-fold-case-slot 'fold-case)
     22     (read p)))
     23
     24  (##sys#set-read-mark!
     25   'no-fold-case
     26   (lambda (p)
     27     (##sys#setslot p port-fold-case-slot 'no-fold-case)
     28     (read p)))
     29
     30  (set! ##sys#read
     31    (let ((read ##sys#read))
     32      (lambda (port hook)
     33        (parameterize ((case-sensitive
     34                        (case (port-fold-case port)
     35                          ((fold-case) #f)
     36                          ((no-fold-case) #t)
     37                          (else (case-sensitive)))))
     38          (read port hook)))))
     39
     40  ;;;
     41  ;;; 6.13.2 Input
     42  ;;;
    443
    544  (define (data? o)
     
    69108       (##sys#setslot (##sys#slot read-table 3) 61 read-equal/shared))
    70109     (lambda ()
     110       (##sys#check-input-port port #t 'read)
    71111       (read/shared port))
    72112     (lambda ()
  • release/4/r7rs/trunk/tests/run.scm

    r30929 r31045  
    1919
    2020(test-begin "r7rs tests")
     21
     22(test-group "2.1: Identifiers"
     23  (test "#!(no-)fold-case"
     24        '(FOO mooh qux blah foo BAR)
     25        (append
     26         (with-input-from-string
     27          "FOO #!fold-case mooh QUX blah #!no-fold-case foo BAR" read-file)))
     28  (test "#!(no-)fold-case only affects subsequent reads from the same port"
     29        '(FOO bar baz downcased UPCASED)
     30        (append
     31         (with-input-from-string "FOO #!fold-case bar BAZ" read-file)
     32         (with-input-from-string "downcased UPCASED" read-file))))
    2133
    2234(test-group "4.1.7: Inclusion"
Note: See TracChangeset for help on using the changeset viewer.