Megatest

Diff
Login

Differences From Artifact [a33d322bf7]:

To Artifact [3332ad9a8b]:


2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
     (sqlite3:execute 
      db
      "INSERT OR REPLACE into test_steps (test_id,stepname,state,status,event_time,comment,logfile) VALUES(?,?,?,?,?,?,?);"
      test-id teststep-name state-in status-in (current-seconds)
      (if comment comment "")
      (if logfile logfile "")))))



(define (db:delete-steps-for-test! dbstruct run-id test-id)
  ;; TODO: figure out why status is the key field rather than state (note:  CONSTRAINT test_steps_constraint UNIQUE (test_id,stepname,state) )
  (db:with-db
   dbstruct
   run-id
   #t
   (lambda (dbdat db)







<
<







2744
2745
2746
2747
2748
2749
2750


2751
2752
2753
2754
2755
2756
2757
     (sqlite3:execute 
      db
      "INSERT OR REPLACE into test_steps (test_id,stepname,state,status,event_time,comment,logfile) VALUES(?,?,?,?,?,?,?);"
      test-id teststep-name state-in status-in (current-seconds)
      (if comment comment "")
      (if logfile logfile "")))))



(define (db:delete-steps-for-test! dbstruct run-id test-id)
  ;; TODO: figure out why status is the key field rather than state (note:  CONSTRAINT test_steps_constraint UNIQUE (test_id,stepname,state) )
  (db:with-db
   dbstruct
   run-id
   #t
   (lambda (dbdat db)
4252
4253
4254
4255
4256
4257
4258














































4259
4260
4261
4262
4263
4264
4265
	 (begin
	   (debug:print 0 *default-log-port* "WARNING: path given, " outputfile " is relative, prefixing with current directory")
	   (conc (current-directory) "/" outputfile)))
     results)
    ;; brutal clean up
    (dbfile:add-dbdat dbstruct #f dbdat)
    (system "rm -rf tempdir")))















































;; (db:extract-ods-file db "outputfile.ods" '(("sysname" "%")("fsname" "%")("datapath" "%")) "%")

;;======================================================================
;; moving watch dogs here due to dependencies
;;======================================================================








>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







4250
4251
4252
4253
4254
4255
4256
4257
4258
4259
4260
4261
4262
4263
4264
4265
4266
4267
4268
4269
4270
4271
4272
4273
4274
4275
4276
4277
4278
4279
4280
4281
4282
4283
4284
4285
4286
4287
4288
4289
4290
4291
4292
4293
4294
4295
4296
4297
4298
4299
4300
4301
4302
4303
4304
4305
4306
4307
4308
4309
	 (begin
	   (debug:print 0 *default-log-port* "WARNING: path given, " outputfile " is relative, prefixing with current directory")
	   (conc (current-directory) "/" outputfile)))
     results)
    ;; brutal clean up
    (dbfile:add-dbdat dbstruct #f dbdat)
    (system "rm -rf tempdir")))

;;======================================================================
;; cached writes stuff
;;======================================================================

(define (db:add-cached-write dbstruct proc run-id params)
  (debug:print 0 *default-log-port* "Adding cached write for run-id "run-id" params " params)
  (mutex-lock! *cached-writes-mutex*)
  (let* ((hkey                (cons dbstruct run-id))
	 (cached-writes-queue (hash-table-ref/default *cached-writes-queues* hkey '())))
    (hash-table-set! *cached-writes-queues* hkey (cons (list proc params) cached-writes-queue)))
  (if (not *cached-writes-flag*)
      (begin
	(set! *cached-writes-flag* #t)
	(thread-start! (make-thread
			(lambda ()
			  (debug:print 0 *default-log-port* "process cached writes thread started.")
			  (thread-sleep! 1)
			  (db:process-cached-writes-queue))))))
  (mutex-unlock! *cached-writes-mutex*))

(define (db:process-cached-writes-queue)
  (mutex-lock! *cached-writes-mutex*)
  (hash-table-for-each
   *cached-writes-queues*
   (lambda (hkey writes-list)
     (let* ((dbstruct (car hkey))
	    (run-id   (cdr hkey)))
       (debug:print 0 *default-log-port* "Processing "(length writes-list)" cached writes for run "run-id)
       (db:with-db
	dbstruct
	run-id
	#t 
	(lambda (dbdat db)
	  (sqlite3:with-transaction
	   db
	   (lambda ()
	     (for-each
	      (lambda (queued-write)
		(match queued-write
		       ((proc params)(apply proc dbstruct params))
		       (else (assert #f "BAD queued-write"))))
	      writes-list)))
	  (hash-table-delete! *cached-writes-queues* hkey))))))
  (set! *cached-writes-flag* #f)
  (mutex-unlock! *cached-writes-mutex*))

;; (db:extract-ods-file db "outputfile.ods" '(("sysname" "%")("fsname" "%")("datapath" "%")) "%")

;;======================================================================
;; moving watch dogs here due to dependencies
;;======================================================================