Megatest

Check-in [064872f8bc]
Login
Overview
Comment:utils/plot-code.scm
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.63-stackdumpfix
Files: files | file ages | folders
SHA1: 064872f8bc02d7d444503ec8bbba8589bde8b21e
User & Date: matt on 2017-01-06 21:54:20
Other Links: branch diff | manifest | tags
Context
2017-01-06
22:37
Made mt:process-triggers run exclusively on the server side check-in: bcaec59285 user: matt tags: v1.63-stackdumpfix
21:54
utils/plot-code.scm check-in: 064872f8bc user: matt tags: v1.63-stackdumpfix
20:28
wip check-in: fc4e43d81e user: bjbarcla tags: v1.63-stackdumpfix
Changes

Modified common.scm from [6953f07d9c] to [d11f96c7d3].

95
96
97
98
99
100
101

102
103
104
105
106
107
108
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109







+







(define *db-last-sync*        0)                 ;; last time the sync to megatest.db happened
(define *db-sync-in-progress* #f)                ;; if there is a sync in progress do not try to start another
(define *db-multi-sync-mutex* (make-mutex))      ;; protect access to *db-sync-in-progress*, *db-last-sync*
;; task db
(define *task-db*             #f) ;; (vector db path-to-db)
(define *db-access-allowed*   #t) ;; flag to allow access
(define *db-access-mutex*     (make-mutex))
(define *db-transaction-mutex* (make-mutex))
(define *db-cache-path*       #f)

;; SERVER
(define *my-client-signature* #f)
(define *transport-type*    'http)             ;; override with [server] transport http|rpc|nmsg
(define *runremote*         #f)                ;; if set up for server communication this will hold <host port>
(define *max-cache-size*    0)

Modified db.scm from [bafb822f96] to [b31dceb2af].

1959
1960
1961
1962
1963
1964
1965
1966

1967
1968
1969
1970
1971
1972
1973
1959
1960
1961
1962
1963
1964
1965

1966
1967
1968
1969
1970
1971
1972
1973







-
+







	"SELECT state,status,count(id) AS count FROM tests WHERE run_id=? AND NOT(uname='n/a' AND item_path='') GROUP BY state,status;;"
	run-id))))

;; Update run_stats for given run_id
;; input data is a list (state status count)
;;
(define (db:update-run-stats dbstruct run-id stats)
  (mutex-lock! *db-stats-mutex*)
  (mutex-lock! *db-transaction-mutex*)
  (db:with-db
   dbstruct
   #f
   #f

   (lambda (db)
     ;; remove previous data
1981
1982
1983
1984
1985
1986
1987
1988

1989
1990
1991
1992
1993
1994
1995
1981
1982
1983
1984
1985
1986
1987

1988
1989
1990
1991
1992
1993
1994
1995







-
+







		(for-each
		 (lambda (dat)
		   (sqlite3:execute stmt1 run-id (car dat)(cadr dat))
		   (apply sqlite3:execute stmt2 run-id dat))
		 stats)))))
       (sqlite3:finalize! stmt1)
       (sqlite3:finalize! stmt2)
       (mutex-unlock! *db-stats-mutex*)
       (mutex-unlock! *db-transaction-mutex*)
       res))))

(define (db:get-main-run-stats dbstruct run-id)
  (db:with-db
   dbstruct
   #f ;; this data comes from main
   #f
3173
3174
3175
3176
3177
3178
3179
3180

3181
3182
3183
3184
3185
3186
3187
3173
3174
3175
3176
3177
3178
3179

3180
3181
3182
3183
3184
3185
3186
3187







-
+







	 (test-id      (db:test-get-id testdat))
	 (test-name    (if (number? test-name)
			   (db:test-get-testname testdat)
			   test-name))
	 (item-path    (db:test-get-item-path testdat))
         (tl-testdat   (db:get-test-info dbstruct run-id test-name ""))
         (tl-test-id   (db:test-get-id tl-testdat)))
    (mutex-lock! *db-stats-mutex*)
    (mutex-lock! *db-transaction-mutex*)
    (let ((tr-res
           (sqlite3:with-transaction
            db
            (lambda ()
              (db:test-set-state-status-by-id dbstruct run-id test-id state status comment)
              (if (not (equal? item-path "")) ;; only roll up IF incoming test is an item
                  (let* ((state-status-counts  (db:get-all-state-status-counts-for-test db run-id test-name item-path)) ;; item-path is used to exclude current state/status of THIS test
3207
3208
3209
3210
3211
3212
3213
3214
3215


3216
3217
3218
3219
3220
3221
3222
3207
3208
3209
3210
3211
3212
3213


3214
3215
3216
3217
3218
3219
3220
3221
3222







-
-
+
+







                                                    "COMPLETED"
                                                    (car all-curr-states))))
                         (newstatus         (if (> bad-not-started 0)
                                                "CHECK"
                                                (car all-curr-statuses))))
                    ;; (print "Setting toplevel to: " newstate "/" newstatus)
                    (db:test-set-state-status-by-id dbstruct run-id tl-test-id newstate newstatus #f))))))
          (mutex-unlock! *db-stats-mutex*))
      trres)))
          (mutex-unlock! *db-transaction-mutex*))
      tr-res)))

(define db:roll-up-pass-fail-counts db:set-state-status-and-roll-up-items)

;; call with state = #f to roll up with out accounting for state/status of this item
;;
;;    (define (db:roll-up-pass-fail-counts dbstruct run-id test-name item-path state status)
;;      (if (not (equal? item-path "")) ;; if asked to do this for a specific item then do an incremental update

Modified launch.scm from [580823485a] to [5acd6fa77a].

1119
1120
1121
1122
1123
1124
1125
1126
1127


1128
1129
1130
1131
1132
1133
1134
1119
1120
1121
1122
1123
1124
1125


1126
1127
1128
1129
1130
1131
1132
1133
1134







-
-
+
+







			      (conc (if dir (conc dir "/") "")
				    (case (string->symbol exe)
				      ((dboard)    "../megatest")
				      ((mtest)     "../megatest")
				      ((dashboard) "megatest")
				      (else exe)))))
	   (launcher        (common:get-launcher *configdat* test-name item-path)) ;; (config-lookup *configdat* "jobtools"     "launcher"))
	   (test-sig   (conc (common:get-testsuite-name) ":" test-name ":" item-path)) ;; (item-list->path itemdat))) ;; test-path is the full path including the item-path
	   (work-area  #f)
	   (test-sig        (conc (common:get-testsuite-name) ":" test-name ":" item-path)) ;; (item-list->path itemdat))) ;; test-path is the full path including the item-path
	   (work-area       #f)
	   (toptest-work-area #f) ;; for iterated tests the top test contains data relevant for all
	   (diskpath   #f)
	   (cmdparms   #f)
	   (fullcmd    #f) ;; (define a (with-output-to-string (lambda ()(write x))))
	   (mt-bindir-path #f)
	   (testinfo   (rmt:get-test-info-by-id run-id test-id))
	   (mt_target  (string-intersperse (map cadr keyvals) "/"))

Modified utils/nbfake from [9de79bbac2] to [df0eb253b8].

68
69
70
71
72
73
74
75

76
68
69
70
71
72
73
74

75
76







-
+

__EOF

if [[ -z "$MY_NBFAKE_HOST" ]]; then
  # Run locally
  sh -c "cd $CURRWD;export DISPLAY=$DISPLAY; export PATH=$PATH; nohup $* >> $MY_NBFAKE_LOG 2>&1 &"
else
  # run remotely
  ssh -n -f $MY_NBFAKE_HOST "sh -c \"cd $CURRWD;export DISPLAY=$DISPLAY; export PATH=$PATH; nohup $* >> $MY_NBFAKE_LOG 2>&1 &\""
  ssh -X -n -f $MY_NBFAKE_HOST "sh -c \"cd $CURRWD;export DISPLAY=$DISPLAY; export PATH=$PATH; nohup $* >> $MY_NBFAKE_LOG 2>&1 &\""
fi

Modified utils/plot-code.scm from [cd37a2db38] to [903f29a75e].

1
2
3
4
5
6
7
8
9
10
11
12
13

14
15
16
17
18
19


20
21
22
23
24
25
26
1
2
3
4
5
6
7
8
9
10
11
12

13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28












-
+






+
+







#!/mfs/pkgs/chicken/4.8.0.5/bin/csi -nbq

;; Coming soon (right?) Usage: plot-code file1.scm,file2.scm "fun1,fun2,x*" *.scm > plot.dot
;; Usage: plot-code file1.scm,file2.scm *.scm > plot.dot
;;        dot -Tpdf plot.dot > plot.pdf
;; first param is comma separated list of files to include in the map, use - to do all
;; second param is list of regexs for functions to include in the map
;; third param is list of files to scan

(use regex srfi-69 srfi-13)

(define targs #f) 
(define files (cddddr (argv)))
(define files (cdr (cddddr (argv))))

(let ((targdat (cadddr (argv))))
  (if (equal? targdat "-")
      (set! targs files)
      (set! targs (string-split targdat ","))))

(define function-patt (car (cdr (cdddr (argv)))))
(define function-rx   (regexp function-patt))
(define filedat-defns (make-hash-table))
(define filedat-usages (make-hash-table))

(define defn-rx (regexp "^\\s*\\(define\\s+\\(([^\\s\\)]+).*"))
(define all-regexs (make-hash-table))

(define all-fns '())
44
45
46
47
48
49
50

51

52
53
54
55
56
57
58
46
47
48
49
50
51
52
53

54
55
56
57
58
59
60
61







+
-
+







     (lambda ()
       (let loop ((inl (read-line)))
	 (if (not (eof-object? inl))
	     (let ((match (string-match defn-rx inl)))
	       (if match 
		   (let ((fnname (cadr match)))
		     ;; (print "   " fnname)
		     (if (string-match function-rx fnname)
		     (set! all-fns (cons fnname all-fns))
			 (set! all-fns (cons fnname all-fns)))
		     (hash-table-set! 
		      filedat-defns 
		      fname
		      (cons fnname (hash-table-ref/default filedat-defns fname '())))
		     ))
	       (loop (read-line))))))))
 files)