suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

path->module-path: make sure result is always a module path

Browse Source 
Avoid creating a result that is intended as a module path but
has elements that are not syntactically allowed, such as a "."
in a collection-path element.
This commit is contained in:
Matthew Flatt 2016-04-30 07:05:30 -06:00
parent 244d9957f1
commit 76418e9be8
3 changed files with 35 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
pkgs/racket-test/tests/setup/bad%coll/m.rkt Normal file
View File

@ -0,0 +1,2 @@
#lang racket
"The enclosing directory is not a valid collection-path name"

26
pkgs/racket-test/tests/setup/path-to-collects.rkt Normal file
View File

@ -0,0 +1,26 @@
#lang racket/base
(require setup/collects
rackunit
setup/dirs
racket/path)
(check-equal? '(lib "racket/base.rkt")
(path->module-path (build-path (find-collects-dir) "racket" "base.rkt")))
(check-equal? '(collects #"racket" #"base.rkt")
(path->collects-relative (build-path (find-collects-dir) "racket" "base.rkt")))
(check-equal? '(lib "planet/private/nonesuch.rkt")
(path->module-path (build-path (find-collects-dir) "planet" "private" "nonesuch.rkt")))
(check-equal? '(collects #"planet" #"private" #"nonesuch.rkt")
(path->collects-relative (build-path (find-collects-dir) "planet" "private" "nonesuch.rkt")))
(check-equal? (build-path (find-collects-dir) "planet" "private" "none!such.rkt")
(path->module-path (build-path (find-collects-dir) "planet" "private" "none!such.rkt")))
(check-equal? '(collects #"planet" #"private" #"none!such.rkt")
(path->collects-relative (build-path (find-collects-dir) "planet" "private" "none!such.rkt")))
(define here (collection-file-path "path-to-collects.rkt" "tests/setup"))
(check-equal? (build-path here "bad%coll" "m.rkt")
(path->module-path (build-path here "bad%coll" "m.rkt")))
(check-equal? (build-path here "bad%coll" "m.rkt")
(path->collects-relative (build-path here "bad%coll" "m.rkt")))

9
racket/collects/setup/collects.rkt
View File

@ -1,6 +1,7 @@
#lang racket/base #lang racket/base
(require racket/list (require racket/list
racket/string racket/string
setup/collection-name
pkg/path) pkg/path)
(provide path->module-path (provide path->module-path
@ -28,6 +29,9 @@
(cons pkg-collect l) (cons pkg-collect l)
l))) l)))
(define c-p (and (pair? new-c-l) (define c-p (and (pair? new-c-l)
(or (not (eq? mode 'module-path))
(module-path? (car p-l)))
(andmap collection-name-element? new-c-l)
(apply collection-file-path (car p-l) new-c-l (apply collection-file-path (car p-l) new-c-l
#:fail (lambda (msg) #f)))) #:fail (lambda (msg) #f))))
(and c-p (and c-p
@ -36,7 +40,8 @@
[else #f])) [else #f]))
(define p-l (reverse (explode-path simple-p))) (define p-l (reverse (explode-path simple-p)))
(or (and ((length p-l) . > . 2) (or (and ((length p-l) . > . 2)
(regexp-match? #rx#"^[-a-zA-Z0-9_+%.]*$" (path-element->bytes (car p-l))) (or (not (eq? mode 'module-path))
(module-path? (path-element->string (car p-l))))
;; Try using path suffixes as library names, checking whether ;; Try using path suffixes as library names, checking whether
;; `collection-file-path' locates the same path. ;; `collection-file-path' locates the same path.
(let ([file (path-element->string (car p-l))]) (let ([file (path-element->string (car p-l))])
@ -44,7 +49,7 @@
(cond (cond
[(null? p-l) #f] [(null? p-l) #f]
[(null? (cdr p-l)) #f] [(null? (cdr p-l)) #f]
[(regexp-match? #rx#"^[-a-zA-Z0-9_+%]*$" (path-element->bytes (car p-l))) [(collection-name-element? (path-element->string (car p-l)))
(define new-c-l (cons (path-element->string (car p-l)) c-l)) (define new-c-l (cons (path-element->string (car p-l)) c-l))
(define c-p (apply collection-file-path file new-c-l #:fail (lambda (msg) #f))) (define c-p (apply collection-file-path file new-c-l #:fail (lambda (msg) #f)))
(if (and c-p (if (and c-p