Megatest

Check-in [473832ad6f]
Login
Overview
Comment:some progress on unit tests
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | refactor-dbr:dbstruct
Files: files | file ages | folders
SHA1: 473832ad6fb69256d6698a87bce7b25b45a863ea
User & Date: bjbarcla on 2016-01-28 11:00:03
Other Links: branch diff | manifest | tags
Context
2016-01-28
23:22
Little bit further check-in: 8bf767b71b user: matt tags: refactor-dbr:dbstruct
11:00
some progress on unit tests check-in: 473832ad6f user: bjbarcla tags: refactor-dbr:dbstruct
2016-01-26
18:39
fixed db.scm to properly pass symbols (not strings) for keys of alist so alist->db:test calls work check-in: 90bb91e3b2 user: bjbarcla tags: refactor-dbr:dbstruct
Changes

Modified api.scm from [d4c6e4ffa0] to [36f919b0c4].

104
105
106
107
108
109
110

111







112
113
114
115
116
117
118
104
105
106
107
108
109
110
111

112
113
114
115
116
117
118
119
120
121
122
123
124
125







+
-
+
+
+
+
+
+
+







;;    - returns #( flag result )
;;
(define (api:execute-requests dbstruct dat)
  (handle-exceptions
   exn
   (let ((call-chain (get-call-chain)))
     (print-call-chain (current-error-port))
     (debug:print 0 " api:execute-requests/message: "
     (debug:print 0 " message: " ((condition-property-accessor 'exn 'message) exn))       
                  ((condition-property-accessor 'exn 'message "exn message null") exn)
                  " arguments: "
                  ((condition-property-accessor 'exn 'arguments "exn arguments null") exn)
                  " location: "
                  ((condition-property-accessor 'exn 'location "exn location null") exn)

                  )       
     (vector #f (vector exn call-chain dat))) ;; return some stuff for debug if an exception happens
   (if (not (vector? dat))                    ;; it is an error to not receive a vector
       (vector #f #f "remote must be called with a vector")       
       (vector                                   ;; return a vector + the returned data structure
	#t 
	(let ((cmd    (vector-ref dat 0))
	      (params (vector-ref dat 1)))

Modified dashboard-tests.scm from [b9845e18bc] to [c5b1c83cdb].

413
414
415
416
417
418
419
420

421
422
423
424
425
426
427
413
414
415
416
417
418
419

420
421
422
423
424
425
426
427







-
+







    dlog))

;;======================================================================
;;
;;======================================================================
(define (examine-test run-id test-id) ;; run-id run-key origtest)
  (let* ((db-path       (db:dbfile-path run-id)) ;; (conc (configf:lookup *configdat* "setup" "linktree") "/db/" run-id ".db"))
	 (dbstruct      (make-dbr:dbstruct path:  (db:dbfile-path #f) ;; (configf:lookup *configdat* "setup" "linktree") 
	 (dbstruct      (make-dbr:dbstruct-wrapper path:  (db:dbfile-path #f) ;; (configf:lookup *configdat* "setup" "linktree") 
					   local: #t))
	 (testdat        (rmt:get-test-info-by-id run-id test-id)) ;; (db:get-test-info-by-id dbstruct run-id test-id))
	 (db-mod-time   0) ;; (file-modification-time db-path))
	 (last-update   0) ;; (current-seconds))
	 (request-update #t))
    (if (not testdat)
	(begin

Modified dashboard.scm from [b11af2b1c1] to [2973414ade].

88
89
90
91
92
93
94
95

96
97
98
99
100
101
102
88
89
90
91
92
93
94

95
96
97
98
99
100
101
102







-
+







      (print "Failed to find megatest.config, exiting") 
      (exit 1)))

(define *useserver* (or(not (args:get-arg "-use-local"))
			(configf:lookup *configdat* "dashboard" "use-server")))

(define *dbdir* (db:dbfile-path #f)) ;; (conc (configf:lookup *configdat* "setup" "linktree") "/.db"))
(define *dbstruct-local*  (make-dbr:dbstruct path:  *dbdir*
(define *dbstruct-local*  (make-dbr:dbstruct-wrapper path:  *dbdir*
					     local: #t))
(define *db-file-path* (db:dbfile-path 0))

;; HACK ALERT: this is a hack, please fix.
(define *read-only* (not (file-read-access? *db-file-path*)))

(define toplevel #f)

Modified db.scm from [804cf33a6b] to [57558c8677].

40
41
42
43
44
45
46
47

48
49
50
51

52
53
54
55
56
57
58
40
41
42
43
44
45
46

47
48
49
50

51
52
53
54
55
56
57
58







-
+



-
+







;;======================================================================

;; convert to -inline
(define (db:first-result-default db stmt default . params)
  (handle-exceptions
   exn
   (let ((err-status ((condition-property-accessor 'sqlite3 'status #f) exn)))
     ;; check for (exn sqlite3) ((condition-property-accessor 'exn 'message) exn)
     ;; check for (exn sqlite3) ((condition-property-accessor 'exn 'message "exn message null") exn)
     (if (eq? err-status 'done)
	 default
	 (begin
	   (debug:print 0 "ERROR:  query " stmt " failed, params: " params ", error: " ((condition-property-accessor 'exn 'message) exn))
	   (debug:print 0 "ERROR:  query " stmt " failed, params: " params ", error: " ((condition-property-accessor 'exn 'message "exn message null") exn))
	   (print-call-chain (current-error-port))
	   default)))
   (apply sqlite3:first-result db stmt params)))

;; Get/open a database
;;    if run-id => get run specific db
;;    if #f     => get main db
103
104
105
106
107
108
109
110

111
112
113
114
115
116
117
103
104
105
106
107
108
109

110
111
112
113
114
115
116
117







-
+







		    (db:get-db dbstruct run-id)
		    dbstruct)) ;; cheat, allow for passing in a dbdat
	 (db    (db:dbdat-get-db dbdat)))
    (db:delay-if-busy dbdat)
    (handle-exceptions
     exn
     (begin
       (debug:print 0 "ERROR: sqlite3 issue in db:with-db, dbstruct=" dbstruct ", run-id=" run-id ", proc=" proc ", params=" params " error: " ((condition-property-accessor 'exn 'message) exn))
       (debug:print 0 "ERROR: sqlite3 issue in db:with-db, dbstruct=" dbstruct ", run-id=" run-id ", proc=" proc ", params=" params " error: " ((condition-property-accessor 'exn 'message "exn message null") exn))
       (print-call-chain (current-error-port)))
     (let ((res (apply proc db params)))
       (if (vector? dbstruct)(db:done-with dbstruct run-id r/w))
       res))))

;;======================================================================
;; K E E P   F I L E D B   I N   dbstruct
189
190
191
192
193
194
195
196

197
198
199
200
201
202
203
189
190
191
192
193
194
195

196
197
198
199
200
201
202
203







-
+







	  (sqlite3:open-database fname))))) ;; )

;; This routine creates the db. It is only called if the db is not already opened
;; 
(define (db:open-rundb dbstruct run-id #!key (attemptnum 0)(do-not-open #f)) ;;  (conc *toppath* "/megatest.db") (car *configinfo*)))
  (let* ((local  (dbr:dbstruct-local dbstruct))
	 (rdb    (if local
		     (dbr:dbstruct-localdb-set! dbstruct run-id)
		     (dbr:dbstruct-localdb dbstruct run-id)
		     (dbr:dbstruct-inmem dbstruct)))) ;; (dbr:dbstruct-get-runrec dbstruct run-id 'inmem)))
    (if (or rdb
	    do-not-open)
	rdb
	(begin
	  (mutex-lock! *rundb-mutex*)
	  (let* ((dbpath       (db:dbfile-path run-id)) ;; (conc toppath "/db/" run-id ".db"))
279
280
281
282
283
284
285
286

287
288
289
290
291
292
293
279
280
281
282
283
284
285

286
287
288
289
290
291
292
293







-
+







		(db:multi-db-sync #f 'old2new))  ;; migrate data from megatest.db automatically
	    dbdat)))))

;; Make the dbstruct, setup up auxillary db's and call for main db at least once
;;
(define (db:setup run-id #!key (local #f))
  (let* ((dbdir    (db:dbfile-path #f)) ;; (conc (configf:lookup *configdat* "setup" "linktree") "/.db"))
	 (dbstruct (make-dbr:dbstruct path: dbdir local: local)))
	 (dbstruct (make-dbr:dbstruct-wrapper path: dbdir local: local)))
    dbstruct))

;; Open the classic megatest.db file in toppath
;;
(define (db:open-megatest-db)
  (let* ((dbpath       (conc *toppath* "/megatest.db"))
	 (dbexists     (file-exists? dbpath))
574
575
576
577
578
579
580
581

582
583
584
585
586
587
588
574
575
576
577
578
579
580

581
582
583
584
585
586
587
588







-
+







  (mutex-lock! *db-sync-mutex*)
  (handle-exceptions
   exn
   (begin
     (mutex-unlock! *db-sync-mutex*)
     (debug:print 0 "EXCEPTION: database probably overloaded or unreadable in db:sync-tables.")
     (print-call-chain (current-error-port))
     (debug:print 0 " message: " ((condition-property-accessor 'exn 'message) exn))
     (debug:print 0 " message: " ((condition-property-accessor 'exn 'message "exn message null") exn))
     (print "exn=" (condition->list exn))
     (debug:print 0 " status:  " ((condition-property-accessor 'sqlite3 'status) exn))
     (debug:print 0 " src db:  " (db:dbdat-get-path fromdb))
     (for-each (lambda (dbdat)
		 (let ((dbpath (db:dbdat-get-path dbdat)))
		   (debug:print 0 " dbpath:  " dbpath)
		   (if (not (db:repair-db dbdat))
721
722
723
724
725
726
727
728

729
730
731
732
733
734
735
721
722
723
724
725
726
727

728
729
730
731
732
733
734
735







-
+







;;  'new2old      - sync .db/{main,1,2,3 ...}.db to megatest.db
;;  'closeall     - close all opened dbs
;;
;;  run-ids: '(1 2 3 ...) or #f (for all)
;;
(define (db:multi-db-sync run-ids . options)
  (let* ((toppath  (launch:setup-for-run))
	 (dbstruct (if toppath (make-dbr:dbstruct path: toppath) #f))
	 (dbstruct (if toppath (make-dbr:dbstruct-wrapper path: toppath) #f))
	 (mtdb     (if toppath (db:open-megatest-db)))
	 (allow-cleanup (if run-ids #f #t))
	 (run-ids  (if run-ids 
		       run-ids
		       (if toppath (begin
				     (db:delay-if-busy mtdb)
				     (db:get-all-run-ids mtdb)))))
763
764
765
766
767
768
769
770

771
772
773
774
775
776
777
778
779
780

781
782
783
784
785
786
787
788
789
790

791
792
793
794
795
796
797
763
764
765
766
767
768
769

770
771
772
773
774
775
776
777
778
779

780
781
782
783
784
785
786
787
788
789

790
791
792
793
794
795
796
797







-
+









-
+









-
+







    (if (member 'old2new options)
	(begin
	  (db:sync-tables (db:sync-main-list mtdb) mtdb (db:get-db dbstruct #f))
	  (for-each 
	   (lambda (run-id)
	     (db:delay-if-busy mtdb)
	     (let ((testrecs (db:get-all-tests-info-by-run-id mtdb run-id))
		   (dbstruct (if toppath (make-dbr:dbstruct path: toppath local: #t) #f)))
		   (dbstruct (if toppath (make-dbr:dbstruct-wrapper path: toppath local: #t) #f)))
	       (debug:print 0 "INFO: Propagating " (length testrecs) " records for run-id=" run-id " to run specific db")
	       (db:replace-test-records dbstruct run-id testrecs)
	       (sqlite3:finalize! (db:dbdat-get-db (dbr:dbstruct-get-rundb dbstruct)))))
	   run-ids)))

    ;; now ensure all newdb data are synced to megatest.db
    ;; do not use the run-ids list passed in to the function
    ;;
    (if (member 'new2old options)
	(let* ((maindb      (make-dbr:dbstruct path: toppath local: #t))
	(let* ((maindb      (make-dbr:dbstruct-wrapper path: toppath local: #t))
	       (src-run-ids (if run-ids run-ids (db:get-all-run-ids (db:dbdat-get-db (db:get-db maindb 0)))))
	       (all-run-ids (sort (delete-duplicates (cons 0 src-run-ids)) <))
	       (count       1)
	       (total       (length all-run-ids))
	       (dead-runs  '()))
	  (for-each
	   (lambda (run-id)
	     (debug:print 0 "Processing run " (if (eq? run-id 0) " main.db " run-id) ", " count " of " total)
	     (set! count (+ count 1))
	     (let* ((fromdb (if toppath (make-dbr:dbstruct path: toppath local: #t) #f))
	     (let* ((fromdb (if toppath (make-dbr:dbstruct-wrapper path: toppath local: #t) #f))
		    (frundb (db:dbdat-get-db (db:get-db fromdb run-id))))
	       ;; (db:delay-if-busy frundb)
	       ;; (db:delay-if-busy mtdb)
	       ;; (db:clean-up frundb)
	       (if (eq? run-id 0)
		   (begin
		     (db:sync-tables (db:sync-main-list dbstruct) (db:get-db fromdb #f) mtdb)
839
840
841
842
843
844
845
846

847
848
849
850
851
852
853
839
840
841
842
843
844
845

846
847
848
849
850
851
852
853







-
+







   (let ((sleep-time (random 30))
	 (err-status ((condition-property-accessor 'sqlite3 'status #f) exn)))
     (case err-status
       ((busy)
	(thread-sleep! sleep-time))
       (else
	(debug:print 0 "EXCEPTION: database probably overloaded or unreadable.")
	(debug:print 0 " message: " ((condition-property-accessor 'exn 'message) exn))
	(debug:print 0 " message: " ((condition-property-accessor 'exn 'message "exn message null") exn))
	(print "exn=" (condition->list exn))
	(debug:print 0 " status:  " ((condition-property-accessor 'sqlite3 'status) exn))
	(print-call-chain (current-error-port))
	(thread-sleep! sleep-time)
	(debug:print-info 0 "trying db call one more time....this may never recover, if necessary kill process " (current-process-id) " on host " (get-host-name) " to clean up")))
     (apply open-run-close-exception-handling proc idb params))
   (apply open-run-close-no-exception-handling proc idb params)))
3079
3080
3081
3082
3083
3084
3085
3086

3087
3088

3089
3090
3091
3092
3093
3094
3095
3079
3080
3081
3082
3083
3084
3085

3086
3087

3088
3089
3090
3091
3092
3093
3094
3095







-
+

-
+







                                  ELSE 'UNKNOWN' END
                       WHERE testname=? AND item_path='';") ;; DONE

	;; STEPS
	'(delete-test-step-records "UPDATE test_steps SET status='DELETED' WHERE test_id=?;")
	'(delete-test-data-records "UPDATE test_data  SET status='DELETED' WHERE test_id=?;") ;; using status since no state field
	))

;;BB: db:lookup-query - called by db:general-call
(define (db:lookup-query qry-name)
  (let ((q (alist-ref qry-name db:queries)))
  (let ((q (alist-ref (if (string? qry-name) (string->symbol qry-name) qry-name) db:queries)))
    (if q (car q) #f)))

;; do not run these as part of the transaction
(define db:special-queries   '(rollup-tests-pass-fail
			       ;; db:roll-up-pass-fail-counts  ;; WHY NOT!?
			       login
			       immediate
3108
3109
3110
3111
3112
3113
3114
3115
3116
3117
3118
3119






3120
3121
3122
3123
3124
3125
3126
3108
3109
3110
3111
3112
3113
3114





3115
3116
3117
3118
3119
3120
3121
3122
3123
3124
3125
3126
3127







-
-
-
-
-
+
+
+
+
+
+







   ((not (equal? megatest-version calling-version))
    (list #f "Login failed due to mismatch megatest version: " calling-version ", " megatest-version))
   (else
    (hash-table-set! *logged-in-clients* client-signature (current-seconds))
    '(#t "successful login"))))

(define (db:general-call dbdat stmtname params)
  (let ((query (let ((q (alist-ref (if (string? stmtname)
				       (string->symbol stmtname)
				       stmtname)
				   db:queries)))
 		 (if q (car q) #f))))
  ;; (let ((query (let ((q (alist-ref (if (string? stmtname)
  ;;       			       (string->symbol stmtname)
  ;;       			       stmtname)
  ;;       			   db:queries)))
  ;;       	 (if q (car q) #f))))
  (let ((query (db:lookup-query stmtname)))
    (db:delay-if-busy dbdat)
    (apply sqlite3:execute (db:dbdat-get-db dbdat) query params)
    #t))

;; get a summary of state and status counts to calculate a rollup
;;
;; NOTE: takes a db, not a dbstruct

Modified db_records.scm from [4c4fc29305] to [a0465e9dd6].

14
15
16
17
18
19
20










21
22
23
24
25
26
27
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37







+
+
+
+
+
+
+
+
+
+







;;
;; Accessors for a dbstruct
;;

(use defstruct)

(defstruct dbr:dbstruct main strdb path local rundb inmem mtime rtime stime inuse refdb locdbs olddb rundb-path)

;; constructor for dbstruct
;;
(define (make-dbr:dbstruct-wrapper #!key (path #f)(local #f))
  (let ((res (make-dbr:dbstruct)))
    (dbr:dbstruct-path-set! res path)
    (dbr:dbstruct-local-set! res local)
    (dbr:dbstruct-locdbs-set! res (make-hash-table))
    res)) 

;;; (define d1 (make-dbr:dbstruct))
;;; (dbr:dbstruct-main d1)             ==> retrive value
;;; (dbr:dbstruct-main-set! d1 'def)   ==> set value

;; (define-inline (dbr:dbstruct-get-main    vec)    (vector-ref  vec 0)) ;; ( db path )
;; (define-inline (dbr:dbstruct-get-strdb   vec)    (vector-ref  vec 1)) ;; ( db path )
;; (define-inline (dbr:dbstruct-get-path    vec)    (vector-ref  vec 2)) 
60
61
62
63
64
65
66
67
68


69
70
71


72
73
74
75
76
77
78
70
71
72
73
74
75
76


77
78
79


80
81
82
83
84
85
86
87
88







-
-
+
+

-
-
+
+







;; constructor for dbstruct
;;

;; BB: commenting out following 3 methods since they are unused
;; (define (actual-make-dbr:dbstruct #!key (path #f)(local #f))
;;   (make-dbr:dbstruct path: path local: local locdbs: (make-hash-table)))

;; (define (dbr:dbstruct-get-localdb v run-ids)
;;   (hash-table-ref/default (dbr:dbstruct-locdbs v) run-id #f))
(define (dbr:dbstruct-localdb v run-id)
   (hash-table-ref/default (dbr:dbstruct-locdbs v) run-id #f))

;; (define (dbr:dbstruct-set-localdb! v run-id db)
;;   (hash-table-set! (dbr:dbstruct-locdbs v) run-id db))
(define (dbr:dbstruct-localdb-set! v run-id db)
  (hash-table-set! (dbr:dbstruct-locdbs v) run-id db))

(defstruct db:test id run_id testname state status event_time host cpuload
           diskfree uname rundir item-path run_duration final_logf
           comment process_id pass_count fail_count archived )
;; BB: 16ww4.3 begin comment out 
;; (define (make-db:test)(make-vector 20))
;; (define-inline (db:test-get-id           vec) (vector-ref vec 0))

Modified megatest.scm from [0cd2084f02] to [2b98b92e7f].

953
954
955
956
957
958
959
960

961
962
963
964
965
966
967
953
954
955
956
957
958
959

960
961
962
963
964
965
966
967







-
+







;; NOTE: list-runs and list-db-targets operate on local db!!!
;;
;; IDEA: megatest list -runname blah% ...
;;
(if (or (args:get-arg "-list-runs")
	(args:get-arg "-list-db-targets"))
    (if (launch:setup-for-run)
	(let* (;; (dbstruct    (make-dbr:dbstruct path: *toppath* local: (args:get-arg "-local")))
	(let* (;; (dbstruct    (make-dbr:dbstruct-wrapper path: *toppath* local: (args:get-arg "-local")))
	       (runpatt     (args:get-arg "-list-runs"))
	       (testpatt    (common:args-get-testpatt #f))
	       ;; (if (args:get-arg "-testpatt") 
	       ;;  	        (args:get-arg "-testpatt") 
	       ;;  	        "%"))
	       (keys        (rmt:get-keys)) ;; (db:get-keys dbstruct))
	       ;; (runsda   t  (db:get-runs dbstruct runpatt #f #f '()))
1484
1485
1486
1487
1488
1489
1490
1491

1492
1493
1494
1495
1496
1497
1498
1484
1485
1486
1487
1488
1489
1490

1491
1492
1493
1494
1495
1496
1497
1498







-
+







;;======================================================================

(if (args:get-arg "-extract-ods")
    (general-run-call
     "-extract-ods"
     "Make ods spreadsheet"
     (lambda (target runname keys keyvals)
       (let ((dbstruct   (make-dbr:dbstruct path: *toppath* local: #t))
       (let ((dbstruct   (make-dbr:dbstruct-wrapper path: *toppath* local: #t))
	     (outputfile (args:get-arg "-extract-ods"))
	     (runspatt   (or (args:get-arg "-runname")(args:get-arg ":runname")))
	     (pathmod    (args:get-arg "-pathmod")))
	     ;; (keyvalalist (keys->alist keys "%")))
	 (debug:print 2 "Extract ods, outputfile: " outputfile " runspatt: " runspatt " keyvals: " keyvals)
	 (db:extract-ods-file dbstruct outputfile keyvals (if runspatt runspatt "%") pathmod)
	 (db:close-all dbstruct)
1790
1791
1792
1793
1794
1795
1796
1797

1798
1799
1800
1801
1802
1803
1804
1790
1791
1792
1793
1794
1795
1796

1797
1798
1799
1800
1801
1802
1803
1804







-
+







;;======================================================================

;; fakeout readline

(if (or (args:get-arg "-repl")
	(args:get-arg "-load"))
    (let* ((toppath (launch:setup-for-run))
	   (dbstruct (if toppath (make-dbr:dbstruct path: toppath local: (args:get-arg "-local")) #f)))
	   (dbstruct (if toppath (make-dbr:dbstruct-wrapper path: toppath local: (args:get-arg "-local")) #f)))
      (if dbstruct
	  (begin
	    (set! *db* dbstruct)
	    (set! *client-non-blocking-mode* #t)
	    (import extras) ;; might not be needed
	    ;; (import csi)
	    (import readline)

Modified newdashboard.scm from [580f5bac48] to [ed60b2fe21].

82
83
84
85
86
87
88
89

90
91
92
93
94
95
96
82
83
84
85
86
87
88

89
90
91
92
93
94
95
96







-
+








;; ease debugging by loading ~/.dashboardrc
(let ((debugcontrolf (conc (get-environment-variable "HOME") "/.dashboardrc")))
  (if (file-exists? debugcontrolf)
      (load debugcontrolf)))

(define *dbdir* (db:dbfile-path #f)) ;; (conc (configf:lookup *configdat* "setup" "linktree") "/.db"))
(define *dbstruct-local*  (make-dbr:dbstruct path:  *dbdir*
(define *dbstruct-local*  (make-dbr:dbstruct-wrapper path:  *dbdir*
					     local: #t))
(define *db-file-path* (db:dbfile-path 0))

;; HACK ALERT: this is a hack, please fix.
(define *read-only* (not (file-read-access? *db-file-path*)))

(debug:setup)

Modified rmt.scm from [58033889c8] to [ce331832c3].

234
235
236
237
238
239
240
241

242
243
244
245
246
247
248
234
235
236
237
238
239
240

241
242
243
244
245
246
247
248







-
+







    (mutex-unlock! *db-stats-mutex*)
    res))
	  
(define (rmt:open-qry-close-locally cmd run-id params #!key (remretries 5))
  (let* ((dbstruct-local (if *dbstruct-db*
			     *dbstruct-db*
			     (let* ((dbdir (db:dbfile-path #f)) ;;  (conc    (configf:lookup *configdat* "setup" "linktree") "/.db"))
				    (db (make-dbr:dbstruct path:  dbdir local: #t)))
				    (db (make-dbr:dbstruct-wrapper path:  dbdir local: #t)))
			       (set! *dbstruct-db* db)
			       db)))
	 (db-file-path   (db:dbfile-path 0))
	 ;; (read-only      (not (file-read-access? db-file-path)))
	 (start          (current-milliseconds))
	 (resdat         (api:execute-requests dbstruct-local (vector (symbol->string cmd) params)))
	 (success        (vector-ref resdat 0))

Modified tests/unittests/dbrdbstruct.scm from [347487983c] to [e78a243444].

1
2
3
4
5
6
7
8
9
10

11
12

13
14
15
16
17
18
19
1
2
3
4
5
6
7
8
9

10
11

12
13
14
15
16
17
18
19









-
+

-
+







;;======================================================================
;; S E R V E R
;;======================================================================

;; Run like this:
;;
;;  (cd ..;make && make install) && ./rununittest.sh server 1;(cd simplerun;megatest -stop-server 0)

;; BB: 2016-01-20 suspect this file is dead code 
(test #f #t                 (dbr:dbstruct? (make-dbr:dbstruct path: "/tmp")))
(test #f #t                 (dbr:dbstruct? (make-dbr:dbstruct-wrapper path: "/tmp")))

(define dbstruct (make-dbr:dbstruct path: "/tmp"))
(define dbstruct (make-dbr:dbstruct-wrapper path: "/tmp"))

(test #f #t                 (begin (dbr:dbstruct-main-set! dbstruct "blah") #t))
(test #f "blah"             (dbr:dbstruct-main  dbstruct))
(for-each 
 (lambda (run-id)
   (test #f #t                 (vector? (dbr:dbstruct-get-rundb-rec dbstruct run-id))))
 (list 1 2 3 4 5 6 7 8 9 #f))

Modified tests/unittests/runs.scm from [d68c314e56] to [267c3ffa13].

8
9
10
11
12
13
14
15

16
17
18
19
20
21
22
8
9
10
11
12
13
14

15
16
17
18
19
20
21
22







-
+







					  "myrun" 
					  "new"
					  "n/a" 
					  "bob")))

(test #f #t             (rmt:register-test 1 "nada" ""))
(test #f 30001          (rmt:get-test-id 1 "nada" ""))
(test #f "NOT_STARTED"  (vector-ref (rmt:get-test-info-by-id 1 30001) 3)) ;; "nada" "") 3))
(test #f "NOT_STARTED"  (db:test-state (rmt:get-test-info-by-id 1 30001))) ;; "nada" "") 3))

(test #f "FOO LIKE 'abc%def'" (db:patt->like "FOO" "abc%def"))
(test #f "key2" (vector-ref (car (vector-ref (mt:get-runs-by-patt '("SYSTEM" "RELEASE") "%" "key1/key2") 1)) 1))

(test #f "SYSTEM,RELEASE,id,runname,state,status,owner,event_time" (car (runs:get-std-run-fields keys '("id" "runname" "state" "status" "owner" "event_time"))))
(test #f #t (runs:operate-on 'print "%" "%" "%"))