]> git.mdlowis.com Git - archive/dlang-scm.git/commitdiff
Added unit tests for charport initialize and charport-read
authorMike D. Lowis <mike@mdlowis.com>
Wed, 1 Aug 2012 15:53:59 +0000 (11:53 -0400)
committerMike D. Lowis <mike@mdlowis.com>
Wed, 1 Aug 2012 15:53:59 +0000 (11:53 -0400)
source/parse-utils.scm
tests/test.scm
tests/test_parse_utils.scm

index 8c600cf3a0ef70cc791e7b1b592aa755a2f9baa5..e0c2f539d4907ee6059b916119d099a66920dba7 100644 (file)
         (syntree-children=? (cdr ch1) (cdr ch2))))))
 
 (define-record charport port line column)
-(define (charport port) (make-charport port 0 0))
+(define (charport port) (make-charport port 1 1))
 
 (define (charport-read chprt)
   (define ch (read-char (charport-port chprt)))
   (if (char=? ch #\newline)
     (begin
       (charport-line-set! chprt (+ 1 (charport-line chprt)))
-      (charport-column-set! chprt 0))
+      (charport-column-set! chprt 1))
     (charport-column-set! chprt (+ 1 (charport-column chprt))))
   ch)
 
index 48629ba53dccbb29dc0ed236f6ed3dc985ae0cab..0b769445f226f2e307cfd6d870223e87bc4effcb 100644 (file)
@@ -3,7 +3,7 @@
 (define unit-tests '())
 
 (define (register-test! test)
-  (set! unit-tests (append unit-tests (list test))))
+  (set! unit-tests (cons test unit-tests)))
 
 (define (print-summary pass fail)
   (if (zero? fail)
index 1cfdff9712d2b1abb69e2614983e01593166fa59..81304ec13585092820a209ee13cd9706ab484330 100644 (file)
       (list (syntree 'foo "" '()))
       (list (syntree 'bar "" '())))))
 
+; charport
+;------------------------------------------------------------------------------
+(def-test "charport should initialize a charport properly"
+  (call-with-input-string "a"
+    (lambda (input)
+      (define port (charport input))
+      (and (equal? input (charport-port port))
+           (equal? 1 (charport-line port))
+           (equal? 1 (charport-column port))))))
+
+; charport-read
+;------------------------------------------------------------------------------
+(def-test "charport-read should increment column when character is not newline"
+  (call-with-input-string "a"
+    (lambda (input)
+      (define port (charport input))
+      (and (equal? #\a (charport-read port))
+           (equal? 1 (charport-line port))
+           (equal? 2 (charport-column port))))))
+
+(def-test "charport-read should increment line when character is newline"
+  (call-with-input-string "\n"
+    (lambda (input)
+      (define port (charport input))
+      (and (equal? #\newline (charport-read port))
+           (equal? 2 (charport-line port))
+           (equal? 1 (charport-column port))))))
+
 ; char-match
 ;------------------------------------------------------------------------------
 (def-test "char-match should consume and return char if the next char matches"