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

adjust test suite to work on windows and to the new agreement about reproviding

Browse Source
This commit is contained in:
Robby Findler 2011-02-12 11:15:01 -06:00
parent 7eefe74e93
commit ae67464670
1 changed files with 10 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
collects/tests/racket/contract-test.rktl
View File

@ -11306,9 +11306,9 @@ so that propagation occurs.
(define exn:fail:contract:blame-object (contract-eval 'exn:fail:contract:blame-object)) (define exn:fail:contract:blame-object (contract-eval 'exn:fail:contract:blame-object))
(define (get-last-part-of-path sexp) (define (get-last-part-of-path sexp)
(define m (regexp-match #rx"/([-a-z0-9.]*)[^/]*$" (format "~s" sexp))) (define str (format "orig-blame: ~s" sexp))
(printf "sexp: ~s => ~s\n" (format "~s" sexp) m) (define m (regexp-match #rx"[/\\]([-a-z0-9.]*)[^/\\]*$" str))
(and m (cadr m))) (if m (cadr m) str))
;; basic negative blame case ;; basic negative blame case
(let ([blame (let ([blame
@ -11329,10 +11329,7 @@ so that propagation occurs.
(,get-last-part-of-path (blame-positive ,blame))) (,get-last-part-of-path (blame-positive ,blame)))
(ctest "b.rkt" (ctest "b.rkt"
'multi-file-blame1-negative 'multi-file-blame1-negative
(,get-last-part-of-path (blame-negative ,blame))) (,get-last-part-of-path (blame-negative ,blame))))
(ctest "a.rkt"
'multi-file-blame1-user
(,get-last-part-of-path (blame-user ,blame))))
;; basic positive blame case ;; basic positive blame case
(let ([blame (let ([blame
@ -11353,10 +11350,7 @@ so that propagation occurs.
(,get-last-part-of-path (blame-positive ,blame))) (,get-last-part-of-path (blame-positive ,blame)))
(ctest "a.rkt" (ctest "a.rkt"
'multi-file-blame2-negative 'multi-file-blame2-negative
(,get-last-part-of-path (blame-negative ,blame))) (,get-last-part-of-path (blame-negative ,blame))))
(ctest "a.rkt"
'multi-file-blame2-user
(,get-last-part-of-path (blame-user ,blame))))
;; positive blame via a re-provide ;; positive blame via a re-provide
(let ([blame (let ([blame
@ -11379,12 +11373,9 @@ so that propagation occurs.
(ctest "c.rkt" (ctest "c.rkt"
'multi-file-blame3-positive 'multi-file-blame3-positive
(,get-last-part-of-path (blame-positive ,blame))) (,get-last-part-of-path (blame-positive ,blame)))
(ctest "b.rkt" (ctest "a.rkt"
'multi-file-blame3-negative 'multi-file-blame3-negative
(,get-last-part-of-path (blame-negative ,blame))) (,get-last-part-of-path (blame-negative ,blame))))
(ctest "?.rkt"
'multi-file-blame3-user
(,get-last-part-of-path (blame-user ,blame))))
;; negative blame via a re-provide ;; negative blame via a re-provide
(let ([blame (let ([blame
@ -11404,15 +11395,12 @@ so that propagation occurs.
'(require racket/contract) '(require racket/contract)
'(provide/contract [f (-> integer? integer?)]) '(provide/contract [f (-> integer? integer?)])
'(define (f x) 1))))))]) '(define (f x) 1))))))])
(ctest "b.rkt" (ctest "a.rkt"
'multi-file-blame4-positive 'multi-file-blame4-positive
(,get-last-part-of-path (blame-positive ,blame))) (,get-last-part-of-path (blame-positive ,blame)))
(ctest "c.rkt" (ctest "c.rkt"
'multi-file-blame4-negative 'multi-file-blame4-negative
(,get-last-part-of-path (blame-negative ,blame))) (,get-last-part-of-path (blame-negative ,blame))))
(ctest "?.rkt"
'multi-file-blame4-user
(,get-last-part-of-path (blame-user ,blame))))
;; have some sharing in the require graph ;; have some sharing in the require graph
(let ([blame (let ([blame
@ -11436,10 +11424,7 @@ so that propagation occurs.
(,get-last-part-of-path (blame-positive ,blame))) (,get-last-part-of-path (blame-positive ,blame)))
(ctest "server.rkt" (ctest "server.rkt"
'multi-file-blame5-negative 'multi-file-blame5-negative
(,get-last-part-of-path (blame-negative ,blame))) (,get-last-part-of-path (blame-negative ,blame)))))
(ctest "server.rkt"
'multi-file-blame5-user
(,get-last-part-of-path (blame-user ,blame)))))