;; -*- Scheme -*-
;;
;; $Id: stringt59.scm,v 1.1 1998/03/16 08:00:19 foner Exp $

(require 'string:case)
(require 'string:test:equal)
(require 'char-set:whitespace)

(define string:test:case
  (lambda args

    (let* ((pattern/action string:case:pattern/action)
	   (match string:search:match)
	   (skip* string:search:skip*)
	   (ws char-set:whitespace)
	   (pattern string:case:pattern))

    (if (not (null? args)) (display "Testing string:case ... "))

    (string:test:equal
     'string:test:case-a
     (string:case "#include"
       (pattern/action
	 (pattern (match "#") (skip* ws) (match "incude"))
	 (lambda () #t)))
     #f)

    (string:test:equal
     'string:test:case-b
     (string:case "#include"
       (pattern/action
	 (pattern (match "#") (skip* ws) (match "incude"))
	 (lambda () 'fail))
       (pattern/action
	 (pattern (match "#") (skip* ws) (match "include"))
	 (lambda () #t)))
     #t)

    (string:test:equal
     'string:test:case-c
     (string:case "#include"
       (pattern/action (pattern) (lambda () #t)))
     #t)

    (if (not (null? args)) (begin (display "done") (newline)))

    )))

;; eof
