Megatest

Check-in [f84f53eaf5]
Login
Overview
Comment:Added number of unit tests for rmt calls. Fixed couple bugs found in db calls
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.60
Files: files | file ages | folders
SHA1: f84f53eaf5235694e9e171767b959e45cead3285
User & Date: matt on 2015-09-01 00:35:04
Other Links: branch diff | manifest | tags
Context
2015-09-01
00:53
Fixed update pass-fail counts, added more tests check-in: a458af98bb user: matt tags: v1.60
00:35
Added number of unit tests for rmt calls. Fixed couple bugs found in db calls check-in: f84f53eaf5 user: matt tags: v1.60
2015-08-30
23:28
Fixed order in db:compare-itempaths call in calc-prereqs, added some simple tests for get-prereqs check-in: d1b20f31c1 user: matt tags: v1.60
Changes

Modified api.scm from [5db5b30c9b] to [7425d00411].

131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
	    ;; TESTS
	    ((test-set-state-status-by-id)     (apply db:test-set-state-status-by-id dbstruct params))
	    ((delete-test-records)             (apply db:delete-test-records dbstruct params))
	    ((delete-old-deleted-test-records) (apply db:delete-old-deleted-test-records dbstruct params))
	    ((test-set-status-state)           (apply db:test-set-status-state dbstruct params))
	    ((test-set-top-process-pid)        (apply db:test-set-top-process-pid dbstruct params))
	    ((roll-up-pass-fail-counts)        (apply db:roll-up-pass-fail-counts dbstruct params))
	    ((update-pass-fail-counts)         (apply db:general-call dbstruct 'update-pass-fail-counts params))
	    ((top-test-set-per-pf-counts)      (apply db:top-test-set-per-pf-counts dbstruct params))
	    ((test-set-archive-block-id)       (apply db:test-set-archive-block-id dbstruct params))

	    ;; RUNS
	    ((register-run)                 (apply db:register-run dbstruct params))
	    ((set-tests-state-status)       (apply db:set-tests-state-status dbstruct params))
	    ((delete-run)                   (apply db:delete-run dbstruct params))







|







131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
	    ;; TESTS
	    ((test-set-state-status-by-id)     (apply db:test-set-state-status-by-id dbstruct params))
	    ((delete-test-records)             (apply db:delete-test-records dbstruct params))
	    ((delete-old-deleted-test-records) (apply db:delete-old-deleted-test-records dbstruct params))
	    ((test-set-status-state)           (apply db:test-set-status-state dbstruct params))
	    ((test-set-top-process-pid)        (apply db:test-set-top-process-pid dbstruct params))
	    ((roll-up-pass-fail-counts)        (apply db:roll-up-pass-fail-counts dbstruct params))
	    ;; ((update-pass-fail-counts)         (apply db:general-call dbstruct 'update-pass-fail-counts params))
	    ((top-test-set-per-pf-counts)      (apply db:top-test-set-per-pf-counts dbstruct params))
	    ((test-set-archive-block-id)       (apply db:test-set-archive-block-id dbstruct params))

	    ;; RUNS
	    ((register-run)                 (apply db:register-run dbstruct params))
	    ((set-tests-state-status)       (apply db:set-tests-state-status dbstruct params))
	    ((delete-run)                   (apply db:delete-run dbstruct params))

Modified db.scm from [f643ae3f46] to [73b68d7608].

1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
;; register a test run with the db
;;
;; Use: (db:get-value-by-header (db:get-header runinfo)(db:get-rows runinfo))
;;  to extract info from the structure returned
;;
;; NOTE: THIS IS COMPLETELY UNFINISHED. IT GOES WITH rmt:get-get-paths-matching-keynames
;;
(define (db:get-run-ids-matching dbstruct keynames target res)
;; (define (db:get-runs-by-patt dbstruct keys runnamepatt targpatt offset limit) ;; test-name)
  (let* ((tmp      (runs:get-std-run-fields keys '("id" "runname" "state" "status" "owner" "event_time")))
	 (keystr   (car tmp))
	 (header   (cadr tmp))
	 (res     '())
	 (key-patt "")
	 (runwildtype (if (substring-index "%" runnamepatt) "like" "glob"))
	 (qry-str  #f)
	 (keyvals  (if targpatt (keys:target->keyval keys targpatt) '())))
    (for-each (lambda (keyval)
		(let* ((key    (car keyval))
		       (patt   (cadr keyval))
		       (fulkey (conc ":" key))
		       (wildtype (if (substring-index "%" patt) "like" "glob")))
		  (if patt
		      (set! key-patt (conc key-patt " AND " key " " wildtype " '" patt "'"))
		      (begin
			(debug:print 0 "ERROR: searching for runs with no pattern set for " fulkey)
			(exit 6)))))
	      keyvals)
    (set! qry-str (conc "SELECT " keystr " FROM runs WHERE state != 'deleted' AND runname " runwildtype " ? " key-patt " ORDER BY event_time "
			(if limit  (conc " LIMIT " limit)   "")
			(if offset (conc " OFFSET " offset) "")
			";"))
    (debug:print-info 4 "runs:get-runs-by-patt qry=" qry-str " " runnamepatt)
    (db:with-db dbstruct #f #f ;; reads db, does not write to it.
		(lambda (db)
		  (sqlite3:for-each-row
		   (lambda (a . r)
		     (set! res (cons (list->vector (cons a r)) res)))
		   (db:get-db dbstruct #f)
		   qry-str
		   runnamepatt)))
    (vector header res)))

;; Get all targets from the db
;;
(define (db:get-targets dbstruct)
  (let* ((res       '())
	 (keys       (db:get-keys dbstruct))
	 (header     keys) ;; (map key:get-fieldname keys))







|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|







1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
;; register a test run with the db
;;
;; Use: (db:get-value-by-header (db:get-header runinfo)(db:get-rows runinfo))
;;  to extract info from the structure returned
;;
;; NOTE: THIS IS COMPLETELY UNFINISHED. IT GOES WITH rmt:get-get-paths-matching-keynames
;;
;; (define (db:get-run-ids-matching dbstruct keynames target res)
;; ;; (define (db:get-runs-by-patt dbstruct keys runnamepatt targpatt offset limit) ;; test-name)
;;   (let* ((tmp      (runs:get-std-run-fields keys '("id" "runname" "state" "status" "owner" "event_time")))
;; 	 (keystr   (car tmp))
;; 	 (header   (cadr tmp))
;; 	 (res     '())
;; 	 (key-patt "")
;; 	 (runwildtype (if (substring-index "%" runnamepatt) "like" "glob"))
;; 	 (qry-str  #f)
;; 	 (keyvals  (if targpatt (keys:target->keyval keys targpatt) '())))
;;     (for-each (lambda (keyval)
;; 		(let* ((key    (car keyval))
;; 		       (patt   (cadr keyval))
;; 		       (fulkey (conc ":" key))
;; 		       (wildtype (if (substring-index "%" patt) "like" "glob")))
;; 		  (if patt
;; 		      (set! key-patt (conc key-patt " AND " key " " wildtype " '" patt "'"))
;; 		      (begin
;; 			(debug:print 0 "ERROR: searching for runs with no pattern set for " fulkey)
;; 			(exit 6)))))
;; 	      keyvals)
;;     (set! qry-str (conc "SELECT " keystr " FROM runs WHERE state != 'deleted' AND runname " runwildtype " ? " key-patt " ORDER BY event_time "
;; 			(if limit  (conc " LIMIT " limit)   "")
;; 			(if offset (conc " OFFSET " offset) "")
;; 			";"))
;;     (debug:print-info 4 "runs:get-runs-by-patt qry=" qry-str " " runnamepatt)
;;     (db:with-db dbstruct #f #f ;; reads db, does not write to it.
;; 		(lambda (db)
;; 		  (sqlite3:for-each-row
;; 		   (lambda (a . r)
;; 		     (set! res (cons (list->vector (cons a r)) res)))
;; 		   (db:get-db dbstruct #f)
;; 		   qry-str
;; 		   runnamepatt)))
;;     (vector header res)))

;; Get all targets from the db
;;
(define (db:get-targets dbstruct)
  (let* ((res       '())
	 (keys       (db:get-keys dbstruct))
	 (header     keys) ;; (map key:get-fieldname keys))
2368
2369
2370
2371
2372
2373
2374

2375
2376
2377
2378
2379
2380
2381
2382
	     #f
	     (lambda (db)
	       (sqlite3:first-result
		db
		(conc "SELECT count(id) FROM tests WHERE state in ('RUNNING','LAUNCHED','REMOTEHOSTSTART') AND testname in ('"
		      (string-intersperse testnames "','")
		      "') AND NOT (uname = 'n/a' AND item_path='');")) ;; should this include the (uname = 'n/a' ...) ???

	       )))))))
             ;; DEBUG FIXME - need to merge this v.155 query correctly   
             ;; AND testname in (SELECT testname FROM test_meta WHERE jobgroup=?)
             ;; AND NOT (uname = 'n/a' AND item_path = '');"

;; done with run when:
;;   0 tests in LAUNCHED, NOT_STARTED, REMOTEHOSTSTART, RUNNING
(define (db:estimated-tests-remaining dbstruct run-id)







>
|







2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
	     #f
	     (lambda (db)
	       (sqlite3:first-result
		db
		(conc "SELECT count(id) FROM tests WHERE state in ('RUNNING','LAUNCHED','REMOTEHOSTSTART') AND testname in ('"
		      (string-intersperse testnames "','")
		      "') AND NOT (uname = 'n/a' AND item_path='');")) ;; should this include the (uname = 'n/a' ...) ???
	       ))
	    0)))))
             ;; DEBUG FIXME - need to merge this v.155 query correctly   
             ;; AND testname in (SELECT testname FROM test_meta WHERE jobgroup=?)
             ;; AND NOT (uname = 'n/a' AND item_path = '');"

;; done with run when:
;;   0 tests in LAUNCHED, NOT_STARTED, REMOTEHOSTSTART, RUNNING
(define (db:estimated-tests-remaining dbstruct run-id)
3111
3112
3113
3114
3115
3116
3117
3118
3119
3120
3121
3122
3123
3124
3125
3126
;;
;; Run this remotely!!
;;
(define (db:get-matching-previous-test-run-records dbstruct run-id test-name item-path)
  (let* ((dbdat   (db:get-db dbstruct #f))
	 (db      (db:dbdat-get-db dbdat))
	 (keys    (db:get-keys db))
	 (selstr  (string-intersperse (map (lambda (x)(vector-ref x 0)) keys) ","))
	 (qrystr  (string-intersperse (map (lambda (x)(conc (vector-ref x 0) "=?")) keys) " AND "))
	 (keyvals #f)
	 (tests-hash (make-hash-table)))
    ;; first look up the key values from the run selected by run-id
    (db:delay-if-busy dbdat)
    (sqlite3:for-each-row 
     (lambda (a . b)
       (set! keyvals (cons a b)))







|
|







3112
3113
3114
3115
3116
3117
3118
3119
3120
3121
3122
3123
3124
3125
3126
3127
;;
;; Run this remotely!!
;;
(define (db:get-matching-previous-test-run-records dbstruct run-id test-name item-path)
  (let* ((dbdat   (db:get-db dbstruct #f))
	 (db      (db:dbdat-get-db dbdat))
	 (keys    (db:get-keys db))
	 (selstr  (string-intersperse keys ","))
	 (qrystr  (string-intersperse (map (lambda (x)(conc x "=?")) keys) " AND "))
	 (keyvals #f)
	 (tests-hash (make-hash-table)))
    ;; first look up the key values from the run selected by run-id
    (db:delay-if-busy dbdat)
    (sqlite3:for-each-row 
     (lambda (a . b)
       (set! keyvals (cons a b)))
3137
3138
3139
3140
3141
3142
3143
3144
3145
3146
3147
3148
3149
3150
3151
	  ;; collect all matching tests for the runs then
	  ;; extract the most recent test and return that.
	  (debug:print 4 "selstr: " selstr ", qrystr: " qrystr ", keyvals: " keyvals 
		       ", previous run ids found: " prev-run-ids)
	  (if (null? prev-run-ids) '()  ;; no previous runs? return null
	      (let loop ((hed (car prev-run-ids))
			 (tal (cdr prev-run-ids)))
		(let ((results (db:get-tests-for-run dbstruct run-id hed (conc test-name "/" item-path) '() '() #f #f #f #f #f #f)))
		  (debug:print 4 "Got tests for run-id " run-id ", test-name " test-name 
			       ", item-path " item-path " results: " (intersperse results "\n"))
		  ;; Keep only the youngest of any test/item combination
		  (for-each 
		   (lambda (testdat)
		     (let* ((full-testname (conc (db:test-get-testname testdat) "/" (db:test-get-item-path testdat)))
			    (stored-test   (hash-table-ref/default tests-hash full-testname #f)))







|







3138
3139
3140
3141
3142
3143
3144
3145
3146
3147
3148
3149
3150
3151
3152
	  ;; collect all matching tests for the runs then
	  ;; extract the most recent test and return that.
	  (debug:print 4 "selstr: " selstr ", qrystr: " qrystr ", keyvals: " keyvals 
		       ", previous run ids found: " prev-run-ids)
	  (if (null? prev-run-ids) '()  ;; no previous runs? return null
	      (let loop ((hed (car prev-run-ids))
			 (tal (cdr prev-run-ids)))
		(let ((results (db:get-tests-for-run dbstruct hed (conc test-name "/" item-path) '() '() #f #f #f #f #f #f)))
		  (debug:print 4 "Got tests for run-id " run-id ", test-name " test-name 
			       ", item-path " item-path " results: " (intersperse results "\n"))
		  ;; Keep only the youngest of any test/item combination
		  (for-each 
		   (lambda (testdat)
		     (let* ((full-testname (conc (db:test-get-testname testdat) "/" (db:test-get-item-path testdat)))
			    (stored-test   (hash-table-ref/default tests-hash full-testname #f)))

Modified mt.scm from [26df5f3021] to [50f726c0ec].

128
129
130
131
132
133
134
135

136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
			  (cons testn res)))))))))

;;======================================================================
;;  T R I G G E R S
;;======================================================================

(define (mt:process-triggers run-id test-id newstate newstatus)
  (let* ((test-dat      (rmt:get-test-info-by-id run-id test-id))

	 (test-rundir   ;; (rmt:sdb-qry 'getstr ;; (filedb:get-path *fdb*
	  (db:test-get-rundir test-dat)) ;; ) ;; )
	 (test-name     (db:test-get-testname test-dat))
	 (tconfig       #f)
	 (state         (if newstate  newstate  (db:test-get-state  test-dat)))
	 (status        (if newstatus newstatus (db:test-get-status test-dat))))
    (if (and test-rundir   ;; #f means no dir set yet
	     (file-exists? test-rundir)
	     (directory? test-rundir))
	(call-with-environment-variables
	 (list (cons "MT_TEST_NAME" test-name)
	       (cons "MT_TEST_RUN_DIR" test-rundir)
	       (cons "MT_ITEMPATH"     (db:test-get-item-path test-dat)))
	 (lambda ()
	   (push-directory test-rundir)
	   (set! tconfig (mt:lazy-read-test-config test-name))
	   (for-each (lambda (trigger)
		       (let ((cmd  (configf:lookup tconfig "triggers" trigger))
			     (logf (conc  test-rundir "/last-trigger.log")))
			 (if cmd
			     ;; Putting the commandline into ( )'s means no control over the shell. 
			     ;; stdout and stderr will be caught in the NBFAKE or mt_launch.log files
			     ;; or equivalent. No need to do this. Just run it?
			     (let ((fullcmd (conc cmd " " test-id " " test-rundir " " trigger "&")))
			       (debug:print-info 0 "TRIGGERED on " trigger ", running command " fullcmd)
			       (process-run fullcmd)))))
		     (list
		      (conc state "/" status)
		      (conc state "/")
		      (conc "/" status)))
	   (pop-directory))
	  ))))

;;======================================================================
;;  S T A T E   A N D   S T A T U S   F O R   T E S T S 
;;======================================================================

;; speed up for common cases with a little logic
(define (mt:test-set-state-status-by-id run-id test-id newstate newstatus newcomment)







|
>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|







128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
			  (cons testn res)))))))))

;;======================================================================
;;  T R I G G E R S
;;======================================================================

(define (mt:process-triggers run-id test-id newstate newstatus)
  (let* ((test-dat      (rmt:get-test-info-by-id run-id test-id)))
    (if test-dat
	(let* ((test-rundir   ;; (rmt:sdb-qry 'getstr ;; (filedb:get-path *fdb*
		(db:test-get-rundir test-dat)) ;; ) ;; )
	       (test-name     (db:test-get-testname test-dat))
	       (tconfig       #f)
	       (state         (if newstate  newstate  (db:test-get-state  test-dat)))
	       (status        (if newstatus newstatus (db:test-get-status test-dat))))
	  (if (and test-rundir   ;; #f means no dir set yet
		   (file-exists? test-rundir)
		   (directory? test-rundir))
	      (call-with-environment-variables
	       (list (cons "MT_TEST_NAME" test-name)
		     (cons "MT_TEST_RUN_DIR" test-rundir)
		     (cons "MT_ITEMPATH"     (db:test-get-item-path test-dat)))
	       (lambda ()
		 (push-directory test-rundir)
		 (set! tconfig (mt:lazy-read-test-config test-name))
		 (for-each (lambda (trigger)
			     (let ((cmd  (configf:lookup tconfig "triggers" trigger))
				   (logf (conc  test-rundir "/last-trigger.log")))
			       (if cmd
				   ;; Putting the commandline into ( )'s means no control over the shell. 
				   ;; stdout and stderr will be caught in the NBFAKE or mt_launch.log files
				   ;; or equivalent. No need to do this. Just run it?
				   (let ((fullcmd (conc cmd " " test-id " " test-rundir " " trigger "&")))
				     (debug:print-info 0 "TRIGGERED on " trigger ", running command " fullcmd)
				     (process-run fullcmd)))))
			   (list
			    (conc state "/" status)
			    (conc state "/")
			    (conc "/" status)))
		 (pop-directory))
	       ))))))

;;======================================================================
;;  S T A T E   A N D   S T A T U S   F O R   T E S T S 
;;======================================================================

;; speed up for common cases with a little logic
(define (mt:test-set-state-status-by-id run-id test-id newstate newstatus newcomment)

Modified rmt.scm from [a6725903b6] to [6f9d5da858].

329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344

;; hand off a call to one of the db:queries statements
;; added run-id to make looking up the correct db possible 
;;
(define (rmt:general-call stmtname run-id . params)
  (rmt:send-receive 'general-call run-id (append (list stmtname run-id) params)))

(define (rmt:sync-inmem->db run-id)
  (rmt:send-receive 'sync-inmem->db run-id '()))

(define (rmt:sdb-qry qry val run-id)
  ;; add caching if qry is 'getid or 'getstr
  (rmt:send-receive 'sdb-qry run-id (list qry val)))

;; NOT COMPLETED
(define (rmt:runtests user run-id testpatt params)







|
|







329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344

;; hand off a call to one of the db:queries statements
;; added run-id to make looking up the correct db possible 
;;
(define (rmt:general-call stmtname run-id . params)
  (rmt:send-receive 'general-call run-id (append (list stmtname run-id) params)))

;; (define (rmt:sync-inmem->db run-id)
;;   (rmt:send-receive 'sync-inmem->db run-id '()))

(define (rmt:sdb-qry qry val run-id)
  ;; add caching if qry is 'getid or 'getstr
  (rmt:send-receive 'sdb-qry run-id (list qry val)))

;; NOT COMPLETED
(define (rmt:runtests user run-id testpatt params)
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
(define (rmt:test-get-paths-matching-keynames-target-new keynames target res testpatt statepatt statuspatt runname)
  (let ((run-ids (rmt:get-run-ids-matching-target keynames target res runname testpatt statepatt statuspatt)))
    (apply append 
	   (map (lambda (run-id)
		  (rmt:send-receive 'test-get-paths-matching-keynames-target-new run-id (list run-id keynames target res testpatt statepatt statuspatt runname)))
	   run-ids))))

(define (rmt:get-run-ids-matching keynames target res)
  (rmt:send-receive #f 'get-run-ids-matching (list keynames target res)))

(define (rmt:get-prereqs-not-met run-id waitons ref-item-path #!key (mode '(normal))(itemmap #f))
  (rmt:send-receive 'get-prereqs-not-met run-id (list run-id waitons ref-item-path mode itemmap)))

(define (rmt:get-count-tests-running-for-run-id run-id)
  (rmt:send-receive 'get-count-tests-running-for-run-id run-id (list run-id)))








|
|







499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
(define (rmt:test-get-paths-matching-keynames-target-new keynames target res testpatt statepatt statuspatt runname)
  (let ((run-ids (rmt:get-run-ids-matching-target keynames target res runname testpatt statepatt statuspatt)))
    (apply append 
	   (map (lambda (run-id)
		  (rmt:send-receive 'test-get-paths-matching-keynames-target-new run-id (list run-id keynames target res testpatt statepatt statuspatt runname)))
	   run-ids))))

;; (define (rmt:get-run-ids-matching keynames target res)
;;   (rmt:send-receive #f 'get-run-ids-matching (list keynames target res)))

(define (rmt:get-prereqs-not-met run-id waitons ref-item-path #!key (mode '(normal))(itemmap #f))
  (rmt:send-receive 'get-prereqs-not-met run-id (list run-id waitons ref-item-path mode itemmap)))

(define (rmt:get-count-tests-running-for-run-id run-id)
  (rmt:send-receive 'get-count-tests-running-for-run-id run-id (list run-id)))

553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569

(define (rmt:delete-run run-id)
  (rmt:send-receive 'delete-run run-id (list run-id)))

(define (rmt:delete-old-deleted-test-records)
  (rmt:send-receive 'delete-old-deleted-test-records #f '()))

(define (rmt:get-runs runpatt count offset keypatts)
  (rmt:send-receive 'get-runs #f (list runpatt count offset keypatts)))

(define (rmt:get-runs runpatt count offset keypatts)
  (rmt:send-receive 'get-runs #f (list runpatt count offset keypatts)))

(define (rmt:get-all-run-ids)
  (rmt:send-receive 'get-all-run-ids #f '()))

(define (rmt:get-prev-run-ids run-id)







<
<
<







553
554
555
556
557
558
559



560
561
562
563
564
565
566

(define (rmt:delete-run run-id)
  (rmt:send-receive 'delete-run run-id (list run-id)))

(define (rmt:delete-old-deleted-test-records)
  (rmt:send-receive 'delete-old-deleted-test-records #f '()))




(define (rmt:get-runs runpatt count offset keypatts)
  (rmt:send-receive 'get-runs #f (list runpatt count offset keypatts)))

(define (rmt:get-all-run-ids)
  (rmt:send-receive 'get-all-run-ids #f '()))

(define (rmt:get-prev-run-ids run-id)

Modified tests/unittests/misc.scm from [f0ad22a5f3] to [ee63f04fc2].



1
2
3
4
5
6
7


;;======================================================================
;; P R O C E S S E S
;;======================================================================

(test "cmd-run-with-stderr->list" '("No such file or directory")
      (let ((reslst (cmd-run-with-stderr->list "ls" "/tmp/ihadbetternotexist")))
	(string-search (regexp "No such file or directory")(car reslst))))
>
>







1
2
3
4
5
6
7
8
9
(use sqlite3)

;;======================================================================
;; P R O C E S S E S
;;======================================================================

(test "cmd-run-with-stderr->list" '("No such file or directory")
      (let ((reslst (cmd-run-with-stderr->list "ls" "/tmp/ihadbetternotexist")))
	(string-search (regexp "No such file or directory")(car reslst))))
39
40
41
42
43
44
45

































































































































































46
















47
48

;; test:match->sqlqry
(test #f "(testname GLOB 'a' AND item_path GLOB 'b') OR (testname LIKE 'a%' AND item_path LIKE '%') OR (testname GLOB '' AND item_path LIKE 'b%')"
      (tests:match->sqlqry "a/b,a%,/b%"))
(test #f "(testname GLOB 'a' AND item_path GLOB 'b') OR (testname LIKE 'a%' AND item_path LIKE '%') OR (testname LIKE '%' AND item_path LIKE 'b%')"
      (tests:match->sqlqry "a/b,a%,%/b%"))



















































































































































































(exit)








>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>


41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227

;; test:match->sqlqry
(test #f "(testname GLOB 'a' AND item_path GLOB 'b') OR (testname LIKE 'a%' AND item_path LIKE '%') OR (testname GLOB '' AND item_path LIKE 'b%')"
      (tests:match->sqlqry "a/b,a%,/b%"))
(test #f "(testname GLOB 'a' AND item_path GLOB 'b') OR (testname LIKE 'a%' AND item_path LIKE '%') OR (testname LIKE '%' AND item_path LIKE 'b%')"
      (tests:match->sqlqry "a/b,a%,%/b%"))

(let ((cmd             "dunno")
      (run-id          1)
      (rid             1)
      (rawcmd          "dunno")
      (params          '())
      (duration        100)
      (connection-info (vector #f #f #f))
      (dat              "abc")
      (json-str         "\"def\"")
      (item-path        "a/b/c")
      (test-id          1)
      (testpatt         "%/a/%")
      (newstate         "COMPLETED")
      (newstatus        "PASS")
      (newcomment       "Stupid comment")
      (testnames        '("test1" "test2"))
      (currstate        "COMPLETED")
      (currstatus       "FAIL")
      (states           '("COMPLETED" "RUNNING"))
      (statuses         '("PASS" "FAIL"))
      (offset           100)
      (limit            10)
      (not-in           #t)
      (sort-by          #f)
      (sort-order       #f)
      (qryvals          #f)
      (qry              'a)
      (synckey          #f)
      (keynum           1)
      (run-ids          '(1 2 3))
      (state            "RUNNING")
      (status           "FAIL")
      (msg              "Sillyness")
      (test-name        "test184")
      (logf             "/tmp/a.logfile")
      (pid              1234567)
      (target           "a/b/c")
      (res              #f)
      (runname          "myfirstrun")
      (statepatt        "CO%")
      (statuspatt       "PA%")
      (keynames         '("SYSTEM" "RELEASE")) ;; "sysname" "fsname" "datapath"))
      (waitons          '("a" "b" "c"))
      (ref-item-path    "/d/e/f")
      (jobgroup         "anl")
      (runpatt          "run%")
      (keyvals          '("a" "b" "c"))
      (user             "freddy")
      (count            100)
      (keypatts         '("%a" "%b" "%c"))
      (lock             #f)
      (unlock           #t)
      (run-status       "n/a")
      (runnamepatt      "b%")
      (targpatt         "%a/%b/c%")
      (fields           "id,runname")
      (ovr-deadtime     100)
      (teststep-name    "first")
      (state-in         "COMPLETED")
      (status-in        "FAIL")
      (comment          "This is a comment eh!")
      (logfile          "/tmp/alogfile.log")
      (categorypatt     "stats")
      (work-area        "/tmp")
      (fld              "voltage")
      (val              5)
      (csvdata          "id,meas,val\n1,voltage,2")
      (action-patt      "%")
      (param-key        "dunno")
      (testname         "atest")
      (dneeded          10000)
      (bdisk-id         1)
      (archive-path     "tmp")
      (block-id         1)
      (testsuite-name   "fullrun")
      (areakey          "dunno")
      (bdisk-name       "what")
      (bdisk-path       "tmp")
      (df               1000000)
      (archive-block-id 1)
      (stmtname         'blah))
  (test #f #f (rmt:write-frequency-over-limit? cmd run-id))
  (test #f #f (rmt:get-connection-info run-id))
  (test #f #f (rmt:update-db-stats run-id rawcmd params duration))
  (test #f #t (begin (rmt:print-db-stats) #t))
  (test #f '(none . 0) (rmt:get-max-query-average run-id))
  (test #f #f (rmt:send-receive-no-auto-client-setup connection-info cmd run-id params))
  (test #f "\"abc\"" (rmt:dat->json-str dat))
  (test #f "def" (rmt:json-str->dat json-str))
  (test #f #f (rmt:kill-server run-id))
  (test #f #t (begin (rmt:start-server run-id) #t))
  (test #f '(#f "Login failed due to mismatch run-id: " 1 ", " #f) (rmt:login run-id))
  (test #f #f (rmt:login-no-auto-client-setup connection-info run-id))
  (test #f #t (begin (rmt:runtests user run-id testpatt params) #t))
  (test #f '() (rmt:get-key-val-pairs run-id))
  (test #f '("SYSTEM" "RELEASE") (rmt:get-keys))
  (test #f '() (rmt:get-key-vals run-id))
  (test #f (vector '("SYSTEM" "RELEASE") '()) (rmt:get-targets))
  (test #f #t (rmt:register-test run-id test-name item-path))
  (test #f #f (rmt:get-test-id run-id testname item-path))
  (test #f #f (rmt:get-test-info-by-id run-id test-id))
  (test #f #f (rmt:test-get-rundir-from-test-id run-id test-id))
  (test #f #t (database? (rmt:open-test-db-by-test-id run-id test-id work-area: "/tmp")))
  (test #f #t (begin (rmt:set-tests-state-status run-id testnames currstate currstatus newstate newstatus) #t))
  (test #f '() (rmt:get-tests-for-run run-id testpatt states statuses offset limit not-in sort-by sort-order qryvals)) ;;;
  (test #f #t (vector? (car (rmt:get-tests-for-runs-mindata run-ids testpatt states statuses not-in))))
  (test #f #t (begin (rmt:delete-test-records run-id test-id) #t))
  (test #f #t (begin (rmt:test-set-status-state run-id test-id status state msg) #t))  
  (test #f 1  (rmt:test-toplevel-num-items run-id test-name))
  (test #f '() (rmt:get-matching-previous-test-run-records run-id test-name item-path))
  (test #f #f (rmt:test-get-logfile-info run-id test-name))
  (test #f #t (vector? (car (rmt:test-get-records-for-index-file run-id test-name))))
  (test #f #f (rmt:get-testinfo-state-status run-id test-id))
  (test #f #t (rmt:test-set-log! run-id test-id logf))
  (test #f #t (begin (rmt:test-set-top-process-pid run-id test-id pid) #t))
  (test #f #f (rmt:test-get-top-process-pid run-id test-id))
  (test #f '() (rmt:get-run-ids-matching-target keynames target res runname testpatt statepatt statuspatt))
  (test #f '() (rmt:test-get-paths-matching-keynames-target-new keynames target res testpatt statepatt statuspatt runname))
  (test #f '("c" "b" "a") (rmt:get-prereqs-not-met run-id waitons ref-item-path)) ;;  #!key (mode '(normal))(itemmap #f)))
  (test #f 0  (rmt:get-count-tests-running-for-run-id run-id))
  (test #f 0  (rmt:get-count-tests-running run-id))
  (test #f 0  (rmt:get-count-tests-running-for-testname run-id testname))
  (test #f 0  (rmt:get-count-tests-running-in-jobgroup run-id jobgroup))
  (test #f #f (rmt:roll-up-pass-fail-counts run-id test-name item-path state status))
  (test #f #f (rmt:update-pass-fail-counts run-id test-name))
  (test #f #f (rmt:top-test-set-per-pf-counts run-id test-name))
  (test #f #f (rmt:get-run-info run-id))
  (test #f #f (rmt:get-num-runs runpatt))
  (test #f #f (rmt:register-run keyvals runname state status user))
  (test #f #f (rmt:get-run-name-from-id run-id))
  (test #f #f (rmt:delete-run run-id))
  (test #f #f (rmt:delete-old-deleted-test-records))
  (test #f #f (rmt:get-runs runpatt count offset keypatts))
  (test #f #f (rmt:get-all-run-ids))
  (test #f #f (rmt:get-prev-run-ids run-id))
;; (test #f #f (rmt:lock/unlock-run run-id lock unlock user))
;; (test #f #f (rmt:get-run-status run-id))
;; (test #f #f (rmt:set-run-status run-id run-status msg: msg))
;; (test #f #f (rmt:update-run-event_time run-id))
;; (test #f #f (rmt:get-runs-by-patt  keys runnamepatt targpatt offset limit fields)) ;; fields of #f uses default)
;; (test #f #f (rmt:find-and-mark-incomplete run-id ovr-deadtime))
;; (test #f #f (rmt:find-and-mark-incomplete-all-runs ovr-deadtime: ovr-deadtime))
;; (test #f #f (rmt:get-previous-test-run-record run-id test-name item-path))
;; (test #f #f (rmt:teststep-set-status! run-id test-id teststep-name state-in status-in comment logfile))
;; (test #f #f (rmt:get-steps-for-test run-id test-id))
;; (test #f #f (rmt:read-test-data run-id test-id categorypatt work-area: work-area))
;; (test #f #f (rmt:testmeta-add-record testname))
;; (test #f #f (rmt:testmeta-get-record testname))
;; (test #f #f (rmt:testmeta-update-field test-name fld val))
;; (test #f #f (rmt:test-data-rollup run-id test-id status))
;; (test #f #f (rmt:csv->test-data run-id test-id csvdata))
;; (test #f #f (rmt:tasks-find-task-queue-records target run-name test-patt state-patt action-patt))
;; (test #f #f (rmt:tasks-add action owner target runname testpatt params))
;; (test #f #f (rmt:tasks-set-state-given-param-key param-key new-state))
;; 
;; (test #f #f (rmt:archive-get-allocations  testname itempath dneeded))
;; (test #f #f (rmt:archive-register-block-name bdisk-id archive-path))
;; (test #f #f (rmt:archive-allocate-testsuite/area-to-block block-id testsuite-name areakey))
;; (test #f #f (rmt:archive-register-disk bdisk-name bdisk-path df))
;; (test #f #f (rmt:test-set-archive-block-id run-id test-id archive-block-id))
  ;; (test #f #f (rmt:test-get-archive-block-info archive-block-id))
  
  ;; Defer these a little while ...
  ;;
  ;; (test #f #f (rmt:test-set-state-status-by-id run-id test-id newstate newstatus newcomment))
  ;; (test #f #f (rmt:synchash-get run-id proc synckey keynum params))
  ;; (test #f #f (rmt:send-receive cmd rid params #!key (attemptnum 1)) ;; start attemptnum at 1 so the modulo below works as expected)
  ;; (test #f #f (rmt:open-qry-close-locally cmd run-id params #!key (remretries 5)))
  ;; (test #f #f (apply rmt:general-call stmtname run-id params))
  ;; (test #f #f (rmt:sync-inmem->db run-id))
  ;; (test #f #f (rmt:sdb-qry qry val run-id))

  ;; Deprecated or removed
  ;;
  ;; (test #f #f (rmt:get-run-ids-matching keynames target res))

  )

(exit)