1: ;;
    2: ;; testing gauche.fileutil and file.* modules
    3: ;;
    4: 
    5: (use gauche.test)
    6: (test-start "file utilities")
    7: (use srfi-1)
    8: (use srfi-13)
    9: 
   10: ;; shorthand of normalizing pathname.  this doesn't do anything on
   11: ;; unix, but on Windows the separator in PATHNAME is replaced.
   12: (define (n . pathnames) (map sys-normalize-pathname pathnames))
   13: 
   14: ;;------------------------------------------------------------------
   15: (test-section "built-in gauche.fileutil")
   16: 
   17: (define (md p) (sys-mkdir p #o777))
   18: (define (mf p) (with-output-to-file p (cut display "z")))
   19: (define (rmrf p) (sys-system #`"rm -rf ,p"))
   20: 
   21: (and file-exists? (test-module 'gauche.fileutil)) ;; trigger autoload
   22: 
   23: (rmrf "tmp1.o")
   24: 
   25: (define (file-pred-tests path expected)
   26:   (test* #`"file-exists? (,path)" (car expected) (file-exists? path))
   27:   (test* #`"file-is-regular? (,path)" (cadr expected) (file-is-regular? path))
   28:   (test* #`"file-is-directory? (,path)" (caddr expected) (file-is-directory? path)))
   29: 
   30: (file-pred-tests "tmp1.o" '(#f #f #f))
   31: 
   32: (with-output-to-file "tmp1.o" (cut display "Z"))
   33: 
   34: (file-pred-tests "tmp1.o" '(#t #t #f))
   35: 
   36: (sys-unlink "tmp1.o")
   37: (sys-mkdir "tmp1.o" #o777)
   38: 
   39: (file-pred-tests "tmp1.o" '(#t #f #t))
   40: 
   41: (sys-rmdir "tmp1.o")
   42: 
   43: ;;
   44: ;; glob test.
   45: ;; Note: on Windows the file/directory name can't end with a period.
   46: ;; 
   47: (let ()
   48:   (md "tmp1.o")
   49:   (md "tmp1.o/a")
   50:   (mf "tmp1.o/a/b")
   51:   (mf "tmp1.o/a/cc")
   52:   (mf "tmp1.o/a/.d")
   53:   (md "tmp1.o/.a")
   54:   (md "tmp1.o/.a/.d")
   55:   (md "tmp1.o/aa")
   56:   (mf "tmp1.o/aa/b")
   57:   (mf "tmp1.o/aa/.d")
   58:   (mf "tmp1.o/a.a")
   59:   (mf "tmp1.o/a.b")
   60:   (mf "tmp1.o/a.a.a")
   61: 
   62:   ;; literal
   63:   (test* "glob a.a" (n "tmp1.o/a.a")
   64:          (glob "tmp1.o/a.a")
   65:          (pa$ lset= equal?))
   66: 
   67:   ;; nomatch
   68:   (test* "glob z" '()
   69:          (glob "tmp1.o/z")
   70:          (pa$ lset= equal?))
   71: 
   72:   ;; wildcard
   73:   (test* "glob *" (n "tmp1.o/a" "tmp1.o/aa" "tmp1.o/a.a"
   74:                      "tmp1.o/a.b" "tmp1.o/a.a.a")
   75:          (glob "tmp1.o/*")
   76:          (pa$ lset= equal?))
   77: 
   78:   (test* "glob a.*" (n "tmp1.o/a.a" "tmp1.o/a.b" "tmp1.o/a.a.a")
   79:          (glob "tmp1.o/a.*")
   80:          (pa$ lset= equal?))
   81: 
   82:   (test* "glob .*" (n "tmp1.o/.a" "tmp1.o/." "tmp1.o/..")
   83:          (glob "tmp1.o/.*")
   84:          (pa$ lset= equal?))
   85: 
   86:   (test* "glob ?" (n "tmp1.o/a")
   87:          (glob "tmp1.o/?")
   88:          (pa$ lset= equal?))
   89: 
   90:   (test* "glob *?" (n "tmp1.o/a" "tmp1.o/aa" "tmp1.o/a.a"
   91:                       "tmp1.o/a.b" "tmp1.o/a.a.a")
   92:          (glob "tmp1.o/*?")
   93:          (pa$ lset= equal?))
   94: 
   95:   (test* "glob ??" (n "tmp1.o/aa")
   96:          (glob "tmp1.o/??")
   97:          (pa$ lset= equal?))
   98: 
   99:   (test* "glob *.*" (n "tmp1.o/a.a" "tmp1.o/a.b" "tmp1.o/a.a.a")
  100:          (glob "tmp1.o/*.*")
  101:          (pa$ lset= equal?))
  102: 
  103:   (test* "glob */*" (n "tmp1.o/a/b" "tmp1.o/a/cc" "tmp1.o/aa/b")
  104:          (glob "tmp1.o/*/*")
  105:          (pa$ lset= equal?))
  106: 
  107:   (test* "glob */?" (n "tmp1.o/a/b" "tmp1.o/aa/b")
  108:          (glob "tmp1.o/*/?")
  109:          (pa$ lset= equal?))
  110: 
  111:   (test* "glob *  (chdir)" (n "a" "aa" "a.a" "a.b" "a.a.a")
  112:          (begin (sys-chdir "tmp1.o") (begin0 (glob "*") (sys-chdir "..")))
  113:          (pa$ lset= equal?))
  114: 
  115:   (test* "glob */" (n "tmp1.o/a/" "tmp1.o/aa/")
  116:          (glob "tmp1.o/*/")
  117:          (pa$ lset= equal?))
  118: 
  119:   ;; multi
  120:   (test* "glob * .* (multi)" (n "tmp1.o/." "tmp1.o/.." "tmp1.o/.a" "tmp1.o/a"
  121:                                 "tmp1.o/aa" "tmp1.o/a.a" "tmp1.o/a.b"
  122:                                 "tmp1.o/a.a.a")
  123:          (glob '("tmp1.o/*" "tmp1.o/.*"))
  124:          (pa$ lset= equal?))
  125: 
  126:   ;; charset
  127:   (test* "glob a.[ab]" (n "tmp1.o/a.a" "tmp1.o/a.b")
  128:          (glob "tmp1.o/a.[ab]")
  129:          (pa$ lset= equal?))
  130:   (test* "glob a.[[:alpha:]]" (n "tmp1.o/a.a" "tmp1.o/a.b")
  131:          (glob "tmp1.o/a.[[:alpha:]]")
  132:          (pa$ lset= equal?))
  133:   (test* "glob *.[[:alpha:]]" (n "tmp1.o/a.a" "tmp1.o/a.b" "tmp1.o/a.a.a")
  134:          (glob "tmp1.o/*.[[:alpha:]]")
  135:          (pa$ lset= equal?))
  136:   (test* "glob *.[![:alpha:]]" '()
  137:          (glob "tmp1.o/*.[![:alpha:]]")
  138:          (pa$ lset= equal?))
  139:   (test* "glob *.[^[:alpha:]]" '()
  140:          (glob "tmp1.o/*.[^[:alpha:]]")
  141:          (pa$ lset= equal?))
  142:   (test* "glob *.[^A-Z]" (n "tmp1.o/a.a" "tmp1.o/a.b" "tmp1.o/a.a.a")
  143:          (glob "tmp1.o/*.[^A-Z]")
  144:          (pa$ lset= equal?))
  145: 
  146:   (rmrf "tmp1.o")
  147:   )
  148: 
  149: ;;------------------------------------------------------------------
  150: (test-section "file.filter")
  151: (use file.filter)
  152: (test-module 'file.filter)
  153: 
  154: (rmrf "tmp1.o")
  155: (rmrf "tmp2.o")
  156: (with-output-to-file "tmp1.o"
  157:   (lambda () (display "aaa bbb ccc ddd\neee fff ggg hhh\n")))
  158: 
  159: (test* "file.filter tmp1.o -> string"
  160:        "AAA BBB CCC DDDEEE FFF GGG HHH"
  161:        (with-output-to-string
  162:          (lambda ()
  163:            (file-filter (lambda (in out)
  164:                           (port-for-each (lambda (line)
  165:                                            (display (string-upcase line) out))
  166:                                          (lambda () (read-line in))))
  167:                         :input "tmp1.o"))))
  168: 
  169: (test* "file.filter string -> tmp2.o"
  170:        "AAA BBB CCC DDDEEE FFF GGG HHH"
  171:        (begin
  172:          (with-input-from-string "aaa bbb ccc ddd\neee fff ggg hhh\n"
  173:            (lambda ()
  174:              (file-filter (lambda (in out)
  175:                             (port-for-each (lambda (line)
  176:                                              (display (string-upcase line) out))
  177:                                            (lambda () (read-line in))))
  178:                           :output "tmp2.o")))
  179:          (call-with-input-file "tmp2.o" port->string)))
  180: 
  181: (sys-unlink "tmp2.o")
  182: 
  183: (test* "file.filter cleanup" #f
  184:        (with-error-handler
  185:            (lambda (e) (file-exists? "tmp2.o"))
  186:          (lambda ()
  187:            (with-input-from-string "zzz"
  188:              (lambda ()
  189:                (file-filter (lambda (in out) (error "yyy"))
  190:                             :output "tmp2.o"))))))
  191: 
  192: (sys-unlink "tmp2.o")
  193: 
  194: (test* "file.filter cleanup" #t
  195:        (with-error-handler
  196:            (lambda (e) (file-exists? "tmp2.o"))
  197:          (lambda ()
  198:            (with-input-from-string "zzz"
  199:              (lambda ()
  200:                (file-filter (lambda (in out) (error "yyy"))
  201:                             :output "tmp2.o"
  202:                             :keep-output? #t))))))
  203: 
  204: (sys-unlink "tmp2.o")
  205: 
  206: (test* "file.filter temporary"
  207:        '(#f "AAA BBB CCC DDDEEE FFF GGG HHH")
  208:        (let* ((r1
  209:                (with-input-from-string "aaa bbb ccc ddd\neee fff ggg hhh\n"
  210:                  (lambda ()
  211:                    (file-filter
  212:                     (lambda (in out)
  213:                       (port-for-each (lambda (line)
  214:                                        (display (string-upcase line) out))
  215:                                      (lambda () (read-line in)))
  216:                       (file-exists? "tmp2.o"))
  217:                     :output "tmp2.o"
  218:                     :temporary-file "foo"))))
  219:               (r2
  220:                (call-with-input-file "tmp2.o" port->string)))
  221:          (list r1 r2)))
  222: 
  223: (sys-unlink "tmp1.o")
  224: (sys-unlink "tmp2.o")
  225: 
  226: (test-end)