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

Look for randomness notification

Browse Source
This commit is contained in:
Jay McCarthy 2013-12-31 10:22:39 -07:00
parent 669229a911
commit 947bebad23
1 changed files with 11 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
pkgs/plt-services/meta/drdr/analyze.rkt
View File

@ -161,8 +161,8 @@
[(id ps) (in-hash ht)]) [(id ps) (in-hash ht)])
(and (and
(for/or ([p (in-list ps)]) (for/or ([p (in-list ps)])
; XXX This squelch should be disabled if the committer changed this file ;; XXX This squelch should be disabled if the committer changed this file
; XXX But even then it can lead to problems ;; XXX But even then it can lead to problems
(not (path-random? (build-path (revision-trunk-dir cur-rev) (not (path-random? (build-path (revision-trunk-dir cur-rev)
(substring (path->string* p) 1))))) (substring (path->string* p) 1)))))
(not (symbol=? id 'changes)))))) (not (symbol=? id 'changes))))))
@ -272,6 +272,11 @@
(parameterize ([current-rev rev]) (parameterize ([current-rev rev])
(dir-rendering log-dir #:committer? #t))) (dir-rendering log-dir #:committer? #t)))
(define (drdr-random-notification? l)
(and (stdout? l)
(regexp-match #rx"DrDr: This file has random output."
(stdout-bytes l))))
(define (log-rendering log-pth) (define (log-rendering log-pth)
; XXX ; XXX
(if (or #t (file-exists? log-pth)) (if (or #t (file-exists? log-pth))
@ -287,9 +292,11 @@
(define any-stderr? (ormap stderr? output-log)) (define any-stderr? (ormap stderr? output-log))
(define changed? (define changed?
(if (and (previous-rev) (if (and (previous-rev)
(not (path-random? (trunk-path log-pth)))) (not (path-random? (trunk-path log-pth)))
(not (ormap drdr-random-notification? output-log)))
(with-handlers ([exn:fail? (with-handlers ([exn:fail?
; This #f means that new files are NOT considered changed ;; This #f means that new files are
;; NOT considered changed
(lambda (x) #f)]) (lambda (x) #f)])
(define prev-log-pth (define prev-log-pth
((rebase-path (revision-log-dir (current-rev)) ((rebase-path (revision-log-dir (current-rev))