Adding and friends a la #27

This commit is contained in:
Spencer Florence 2015-01-14 20:54:41 -05:00
parent 08f6748e3c
commit 7e4586dd6f
4 changed files with 11 additions and 11 deletions

View File

@ -23,7 +23,7 @@
(define (test-files! #:submod [submod-name 'test] . paths) (define (test-files! #:submod [submod-name 'test] . paths)
(unless ns (unloaded-error)) (unless ns (unloaded-error))
(define abs (define abs
(for/list ([p paths]) (for/list ([p (in-list paths)])
(if (list? p) (if (list? p)
(cons (->absolute (car p)) (cdr p)) (cons (->absolute (car p)) (cdr p))
(->absolute p)))) (->absolute p))))
@ -35,7 +35,7 @@
[current-output-port [current-output-port
(if (verbose) (current-output-port) (open-output-nowhere))]) (if (verbose) (current-output-port) (open-output-nowhere))])
(define tests-failed #f) (define tests-failed #f)
(for ([p paths]) (for ([p (in-list paths)])
(vprintf "attempting to run ~s\n" p) (vprintf "attempting to run ~s\n" p)
(define old-check (current-check-handler)) (define old-check (current-check-handler))
(define path (if (list? p) (car p) p)) (define path (if (list? p) (car p) p))
@ -129,7 +129,7 @@
;; remove those that cannot be annotated ;; remove those that cannot be annotated
(define can-annotate (define can-annotate
(filter values (filter values
(for/list ([(stx covered?) (get-raw-coverage)]) (for/list ([(stx covered?) (in-hash (get-raw-coverage))])
(and (syntax? stx) (and (syntax? stx)
(let* ([orig-src (syntax-source stx)] (let* ([orig-src (syntax-source stx)]
[src (if (path? orig-src) (path->string orig-src) orig-src)] [src (if (path? orig-src) (path->string orig-src) orig-src)]

View File

@ -112,7 +112,7 @@
;; Generates a string that represents a valid coveralls json_file object ;; Generates a string that represents a valid coveralls json_file object
(define (generate-source-files coverage) (define (generate-source-files coverage)
(define src-files (define src-files
(for/list ([file (hash-keys coverage)]) (for/list ([file (in-list (hash-keys coverage))])
(define local-file (path->string (find-relative-path (current-directory) file))) (define local-file (path->string (find-relative-path (current-directory) file)))
(define src (file->string file)) (define src (file->string file))
(define c (line-coverage coverage file)) (define c (line-coverage coverage file))
@ -154,7 +154,7 @@
[else (json-null)])) [else (json-null)]))
(define-values (line-cover _) (define-values (line-cover _)
(for/fold ([coverage '()] [count 1]) ([line split-src]) (for/fold ([coverage '()] [count 1]) ([line (in-list split-src)])
(cond [(zero? (string-length line)) (values (cons (json-null) coverage) (add1 count))] (cond [(zero? (string-length line)) (values (cons (json-null) coverage) (add1 count))]
[else (define nw-count (+ count (string-length line) 1)) [else (define nw-count (+ count (string-length line) 1))
(define all-covered (foldr process-coverage 'irrelevant (range count nw-count))) (define all-covered (foldr process-coverage 'irrelevant (range count nw-count)))
@ -195,7 +195,7 @@
(define (parse-git-remote raw) (define (parse-git-remote raw)
(define lines (string-split raw "\n")) (define lines (string-split raw "\n"))
(define fetch-only (filter (λ (line) (regexp-match #rx"\\(fetch\\)" line)) lines)) (define fetch-only (filter (λ (line) (regexp-match #rx"\\(fetch\\)" line)) lines))
(for/list ([line fetch-only]) (for/list ([line (in-list fetch-only)])
(define split (string-split line)) (define split (string-split line))
(hasheq 'name (list-ref split 0) (hasheq 'name (list-ref split 0)
'url (list-ref split 1)))) 'url (list-ref split 1))))
@ -212,6 +212,6 @@
(define command (string-append "git --no-pager log -1 --pretty=format:" format)) (define command (string-append "git --no-pager log -1 --pretty=format:" format))
(define log (with-output-to-string (thunk (system command)))) (define log (with-output-to-string (thunk (system command))))
(define lines (string-split log "\n")) (define lines (string-split log "\n"))
(for/hasheq ([field '(id author_name author_email committer_name committer_email message)] (for/hasheq ([field (in-list '(id author_name author_email committer_name committer_email message))]
[line lines]) [line (in-list lines)])
(values field line))) (values field line)))

View File

@ -49,7 +49,7 @@
(define irrelevant? (make-irrelevant? lexer f)) (define irrelevant? (make-irrelevant? lexer f))
(define file-length (string-length (file->string f))) (define file-length (string-length (file->string f)))
(define cache (define cache
(for/hash ([i (range 1 (add1 file-length))]) (for/hash ([i (in-range 1 (add1 file-length))])
(values i (values i
(cond [(irrelevant? i) 'irrelevant] (cond [(irrelevant? i) 'irrelevant]
[else (raw-covered? i c)])))) [else (raw-covered? i c)]))))

View File

@ -136,7 +136,7 @@
(define full-argv (append expanded-argv args)) (define full-argv (append expanded-argv args))
(if (should-omit? (current-directory) full-omits) (if (should-omit? (current-directory) full-omits)
null null
(for/list ([p (directory-list)]) (for/list ([p (in-list (directory-list))])
(cond [(directory-exists? p) (cond [(directory-exists? p)
(parameterize ([current-directory (build-path (current-directory) p)]) (parameterize ([current-directory (build-path (current-directory) p)])
(expand-directory exts full-omits full-argv))] (expand-directory exts full-omits full-argv))]
@ -189,7 +189,7 @@
;; Coverage -> Coverage ;; Coverage -> Coverage
(define (remove-excluded-paths cover paths) (define (remove-excluded-paths cover paths)
(for/hash ([(k v) cover] (for/hash ([(k v) (in-hash cover)]
#:unless (is-excluded-path? k paths)) #:unless (is-excluded-path? k paths))
(values k v))) (values k v)))