Megatest

Diff
Login

Differences From Artifact [b1837f1312]:

To Artifact [0a367c507f]:


2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
     (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)







<
<







2737
2738
2739
2740
2741
2742
2743


2744
2745
2746
2747
2748
2749
2750
     (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)
4245
4246
4247
4248
4249
4250
4251














































4252
4253
4254
4255
4256
4257
4258
	 (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
;;======================================================================








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







4243
4244
4245
4246
4247
4248
4249
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
	 (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
;;======================================================================