racket/collects/tests/planet2/tests-name.rkt
Matthew Flatt 381d9d84d6 raco pkg: switch from "METADATA.rktd" to "info.rkt"
For now, "METADATA.rktd" is still recognized as a fallback.

Also, rewrite package source type and name inference,
make ".zip" the default format for `raco pkg create',
and many doc edits.
2012-11-30 19:09:19 -07:00

76 lines
5.3 KiB
Racket

#lang racket/base
(require rackunit
planet2/name
"util.rkt")
(define-syntax check-equal-values?
(syntax-rules (values)
[(_ expr (values a ...))
(check-equal? (call-with-values (lambda () expr) list) (list a ...))]))
(define (run-pkg-tests)
(check-equal-values? (package-source->name+type "" #f) (values #f #f))
(check-equal-values? (package-source->name+type "fish" #f) (values "fish" 'name))
(check-equal-values? (package-source->name+type "fish" 'name) (values "fish" 'name))
(check-equal-values? (package-source->name+type "fish!" 'name) (values #f 'name))
(check-equal-values? (package-source->name+type "fish/" 'name) (values #f 'name))
(check-equal-values? (package-source->name+type "fish123A_B-C" #f) (values "fish123A_B-C" 'name))
(check-equal-values? (package-source->name+type "fish123A_B-C!" 'name) (values #f 'name))
(check-equal-values? (package-source->name+type "fish.plt" #f) (values "fish" 'file))
(check-equal-values? (package-source->name+type "fish.zip" #f) (values "fish" 'file))
(check-equal-values? (package-source->name+type "fish.tar" #f) (values "fish" 'file))
(check-equal-values? (package-source->name+type "fish.tgz" #f) (values "fish" 'file))
(check-equal-values? (package-source->name+type "fish.tar.gz" #f) (values "fish" 'file))
(check-equal-values? (package-source->name+type "ocean/fish.tar.gz" #f) (values "fish" 'file))
(check-equal-values? (package-source->name+type "fish.plt" 'file) (values "fish" 'file))
(check-equal-values? (package-source->name+type "fish.tar.gz" 'file) (values "fish" 'file))
(check-equal-values? (package-source->name+type "fish.other" 'file) (values "fish" 'file))
(check-equal-values? (package-source->name+type "fish" 'file) (values "fish" 'file))
(check-equal-values? (package-source->name+type "fish!" 'file) (values #f 'file))
(check-equal-values? (package-source->name+type "fish/" #f) (values "fish" 'dir))
(check-equal-values? (package-source->name+type "./fish" #f) (values "fish" 'dir))
(check-equal-values? (package-source->name+type "sub/fish" #f) (values "fish" 'dir))
(check-equal-values? (package-source->name+type "fish/" 'dir) (values "fish" 'dir))
(check-equal-values? (package-source->name+type "fish/" 'link) (values "fish" 'link))
(check-equal-values? (package-source->name+type "fish" 'dir) (values "fish" 'dir))
(check-equal-values? (package-source->name+type "fish!/" 'dir) (values #f 'dir))
(check-equal-values? (package-source->name+type "http://racket-lang.org/fish.plt" #f) (values "fish" 'file-url))
(check-equal-values? (package-source->name+type "https://racket-lang.org/fish.plt" #f) (values "fish" 'file-url))
(check-equal-values? (package-source->name+type "http://racket-lang.org/fish.tar.gz" #f) (values "fish" 'file-url))
(check-equal-values? (package-source->name+type "http://racket-lang.org/fish" 'file-url) (values "fish" 'file-url))
(check-equal-values? (package-source->name+type "fish" 'file-url) (values "fish" 'file-url))
(check-equal-values? (package-source->name+type "dir/fish" 'file-url) (values "fish" 'file-url))
(check-equal-values? (package-source->name+type "fish/" 'file-url) (values "fish" 'file-url))
(check-equal-values? (package-source->name+type "http://racket-lang.org/fish!" 'file-url) (values #f 'file-url))
(check-equal-values? (package-source->name+type "http://racket-lang.org/fish/" #f) (values "fish" 'dir-url))
(check-equal-values? (package-source->name+type "http://racket-lang.org/fish/" 'dir-url) (values "fish" 'dir-url))
(check-equal-values? (package-source->name+type "http://racket-lang.org/fish" 'dir-url) (values "fish" 'dir-url))
(check-equal-values? (package-source->name+type "http://racket-lang.org/fish.plt" 'dir-url) (values #f 'dir-url))
(check-equal-values? (package-source->name+type "http://racket-lang.org/fish" #f) (values "fish" 'dir-url))
(check-equal-values? (package-source->name+type "github://github.com/racket/fish/master" #f) (values "fish" 'github))
(check-equal-values? (package-source->name+type "github://github.com/racket/fish/release" #f) (values "fish" 'github))
(check-equal-values? (package-source->name+type "github://github.com/racket/fish/release/catfish" #f) (values "catfish" 'github))
(check-equal-values? (package-source->name+type "github://github.com/racket/fish/release/catfish/" #f) (values "catfish" 'github))
(check-equal-values? (package-source->name+type "github://github.com/racket/fish/release/catfish/bill" #f) (values "bill" 'github))
(check-equal-values? (package-source->name+type "github://github.com/racket/fish/master" 'github) (values "fish" 'github))
(check-equal-values? (package-source->name+type "racket/fish/master" 'github) (values "fish" 'github))
(check-equal-values? (package-source->name+type "racket/fish/master/" 'github) (values "fish" 'github))
(check-equal-values? (package-source->name+type "github://github.com/fish/master" 'github) (values #f 'github))
(check-equal-values? (package-source->name+type "fish/master" 'github) (values #f 'github))
(check-equal-values? (package-source->name+type "github://github.com/racket/fish.more/release" 'github) (values #f 'github))
(check-equal-values? (package-source->name+type "random://racket-lang.org/fish.plt" #f) (values #f #f))
(void))
(provide run-pkg-tests)
(module+ main
(run-pkg-tests* run-pkg-tests))