Overview
Comment: | Use dot for sorting tests |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.60 |
Files: | files | file ages | folders |
SHA1: |
7a861112337214c4e238cc07b5aecbe5 |
User & Date: | matt on 2015-10-09 00:53:17 |
Other Links: | branch diff | manifest | tags |
Context
2015-10-12
| ||
14:43 | Oops, left in a bit of broken debugging code. check-in: a556b1654d user: mrwellan tags: v1.60 | |
2015-10-09
| ||
08:38 | use dot for layout of tests check-in: f76c9546af user: matt tags: use-dot | |
00:53 | Use dot for sorting tests check-in: 7a86111233 user: matt tags: v1.60 | |
2015-10-08
| ||
09:13 | Added check for directory availability (to handle NFS quirk) before executing a test check-in: a22586ca18 user: mrwellan tags: v1.60 | |
Changes
Modified tests.scm from [86ae662ea5] to [528a547e4b].
︙ | ︙ | |||
819 820 821 822 823 824 825 | (debug:print 0 "case5") (string>? a b)))))) (sort-fn2 (lambda (a b) (> (mungepriority (tests:testqueue-get-priority (hash-table-ref test-records a))) (mungepriority (tests:testqueue-get-priority (hash-table-ref test-records b))))))) | > > > > > > > > | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 | (debug:print 0 "case5") (string>? a b)))))) (sort-fn2 (lambda (a b) (> (mungepriority (tests:testqueue-get-priority (hash-table-ref test-records a))) (mungepriority (tests:testqueue-get-priority (hash-table-ref test-records b))))))) ;; (let ((dot-res (tests:run-dot (tests:tests->dot test-records) "plain"))) ;; (debug:print "dot-res=" dot-res)) (let ((data (map cdr (filter (lambda (x)(equal? "node" (car x))) (map string-split (tests:easy-dot test-records "plain")))))) (map car (sort data (lambda (a b) (> (string->number (caddr a))(string->number (caddr b))))))) )) ;; (sort all-tests sort-fn1))) ;; avoid dealing with deleted tests, look at the hash table (define (tests:easy-dot test-records outtype) (let-values (((fd temp-path) (file-mkstemp (conc "/tmp/" (current-user-name) ".XXXXXX")))) (let ((all-testnames (hash-table-keys test-records)) (temp-port (open-output-file* fd))) ;; (format temp-port "This file is ~A.~%" temp-path) (format temp-port "digraph tests {\n") (for-each (lambda (testname) (let* ((testrec (hash-table-ref test-records testname)) (waitons (or (tests:testqueue-get-waitons testrec) '()))) (for-each (lambda (waiton) (format temp-port (conc " " waiton " -> " testname "\n"))) waitons))) all-testnames) (format temp-port "}\n") (close-output-port temp-port) (with-input-from-pipe (conc "dot -T" outtype " < " temp-path) (lambda () (let ((res (read-lines))) ;; (delete-file temp-path) res)))))) (define (tests:write-dot-file test-records fname) (if (file-write-access? (pathname-directory fname)) (map print (tests:tests->dot test-records)))) (define (tests:tests->dot test-records) (let ((all-testnames (hash-table-keys test-records))) (if (null? all-testnames) '() (let loop ((hed (car all-testnames)) (tal (cdr all-testnames)) (res (list "digraph tests {"))) (let* ((testrec (hash-table-ref test-records hed)) (waitons (or (tests:testqueue-get-waitons testrec) '())) (newres (append res (map (lambda (waiton) (conc " " waiton " -> " hed)) waitons)))) (if (null? tal) (append newres (list "}")) (loop (car tal)(cdr tal) newres) )))))) ;; (tests:run-dot (list "digraph tests {" "a -> b" "}") "plain") (define (tests:run-dot indat outtype) ;; outtype is plain, fig, dot, etc. http://www.graphviz.org/content/output-formats (print "indat: ") (map print indat) (let-values (((inp oup pid)(process "dot" (list "-T" outtype)))) (let ((th1 (make-thread (lambda () (with-output-to-port oup (lambda () (map print indat)))) "dot writer"))) (thread-start! th1) (let ((res (with-input-from-port inp (lambda () (read-lines))))) (thread-join! th1) (close-input-port inp) (close-output-port oup) ;; (process-wait pid) res)))) ;; for each test: ;; (define (tests:filter-non-runnable run-id testkeynames testrecordshash) (let ((runnables '())) (for-each (lambda (testkeyname) |
︙ | ︙ |