Megatest

Check-in [c832f1154e]
Login
Overview
Comment:Trial 6. Remove use of db_records.scm and use raw vector calls.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | v1.65-cleanup-try-6
Files: files | file ages | folders
SHA1: c832f1154ee91fe9d2e845d98aefc25a63b77f6b
User & Date: matt on 2020-10-04 23:23:14
Other Links: branch diff | manifest | tags
Context
2020-10-04
23:23
Trial 6. Remove use of db_records.scm and use raw vector calls. Leaf check-in: c832f1154e user: matt tags: v1.65-cleanup-try-6
23:03
Trial 5. Revert code that gates test start based on state/status. Closed-Leaf check-in: 89de0f530c user: matt tags: v1.65-cleanup-try-5
Changes

Modified rmt.scm from [29d7593e43] to [9cc59c421a].

20
21
22
23
24
25
26
27
28
29
30
31
32
33
34

(use format typed-records) ;; RADT => purpose of json format??

(declare (unit rmt))
(declare (uses api))
(declare (uses http-transport))
(include "common_records.scm")
(include "db_records.scm")

;; (declare (uses rmtmod))

;; (import rmtmod)

;;
;; THESE ARE ALL CALLED ON THE CLIENT SIDE!!!







|







20
21
22
23
24
25
26
27
28
29
30
31
32
33
34

(use format typed-records) ;; RADT => purpose of json format??

(declare (unit rmt))
(declare (uses api))
(declare (uses http-transport))
(include "common_records.scm")
;; (include "db_records.scm")

;; (declare (uses rmtmod))

;; (import rmtmod)

;;
;; THESE ARE ALL CALLED ON THE CLIENT SIDE!!!
530
531
532
533
534
535
536

537
538





539
540
541
542
543


544
545
546
547
548
549
550
551
  (rmt:send-receive 'get-test-id run-id (list run-id testname item-path)))

;; run-id is NOT used - but it will be! 
;;
(define (rmt:get-test-info-by-id run-id test-id)
  (if (number? test-id)
      (let* ((testdat  (rmt:send-receive 'get-test-info-by-id run-id (list run-id test-id)))

	     (trundatf (conc (db:test-get-rundir testdat) "/.mt_data/test-run.dat")))
	;; now we can update a couple fields from the filesystem





	(if (and (db:test-get-rundir testdat)
		 (file-exists? trundatf))
	    (let* ((duration   (db:test-get-run_duration testdat))
		   (event-time (db:test-get-event_time   testdat))
		   (last-touch (file-modification-time trundatf)))


	      (db:test-set-run_duration! testdat (max duration (- last-touch event-time)))))
	testdat)
      (begin
	(debug:print 0 *default-log-port* "WARNING: Bad data handed to rmt:get-test-info-by-id run-id=" run-id ", test-id=" test-id)
	(print-call-chain (current-error-port))
	#f)))

(define (rmt:test-get-rundir-from-test-id run-id test-id)







>
|

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







530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
  (rmt:send-receive 'get-test-id run-id (list run-id testname item-path)))

;; run-id is NOT used - but it will be! 
;;
(define (rmt:get-test-info-by-id run-id test-id)
  (if (number? test-id)
      (let* ((testdat  (rmt:send-receive 'get-test-info-by-id run-id (list run-id test-id)))
             (trundir  (vector-ref testdat 10))
	     (trundatf (conc trundir"/.mt_data/test-run.dat")))
	;; now we can update a couple fields from the filesystem
	(handle-exceptions
	    exn
	    (begin
	      (debug:print-info 0 *default-log-port* "Could not update testdat record from "trundatf", exn=" exn)
	      #f)
	  (if (and trundir
		   (file-exists? trundatf))
	      (let* ((duration     (vector-ref testdat 12)) ;; (db:test-get-run_duration testdat))
		     (event-time   (vector-ref testdat 5))   ;; (db:test-get-event_time   testdat))
		     (last-touch   (file-modification-time trundatf))
		     (new-duration (max duration (- last-touch event-time))))
		(vector-set! testdat 12 new-duration))))
	      #;(db:test-set-run_duration! testdat (max duration (- last-touch event-time)))
	testdat)
      (begin
	(debug:print 0 *default-log-port* "WARNING: Bad data handed to rmt:get-test-info-by-id run-id=" run-id ", test-id=" test-id)
	(print-call-chain (current-error-port))
	#f)))

(define (rmt:test-get-rundir-from-test-id run-id test-id)