Megatest

Diff
Login

Differences From Artifact [c58d29f4fc]:

To Artifact [8e2c411065]:


297
298
299
300
301
302
303

304
305
306
307
308
309
310
311
312
313

314
315

316
317
318
319
320
321
322
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313

314
315

316
317
318
319
320
321
322
323







+









-
+

-
+








     )))

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

;; FOR DEBUGGING SET TO #t
(define *localmode* #t)
(define *dbstruct* (make-dbr:dbstruct))

;; Defaults to current area
;;
(define (rmt:send-receive cmd rid params #!key (attemptnum 1)(area-dat #f))
  (if (not *rmt:remote*)(set! *rmt:remote* (make-rmt:remote)))
  (let* ((apath      *toppath*)
	 (conns      *rmt:remote*)
	 (dbname     (db:run-id->dbname rid)))
    (if *localmode*
	(let* ((dbstruct (db:cache-get-dbstruct rid apath))
	(let* ((dbdat    (dbr:dbstruct-get-dbdat *dbstruct* dbname))
	       (indat    `((cmd . ,cmd)(params . ,params))))
	  (api:process-request dbstruct indat))
	  (api:process-request *dbstruct* indat))
	(begin
	  (rmt:general-open-connection conns apath dbname)
	  (rmt:send-receive-real conns apath dbname cmd params)))))

#;(define (rmt:send-receive-setup conn)
  (if (not (rmt:conn-inport conn))
      (let-values (((i o) (tcp-connect (rmt:conn-ipaddr conn)
758
759
760
761
762
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
759
760
761
762
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







-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+







  ;; (if (rmt:send-receive 'have-incompletes? run-id (list run-id ovr-deadtime))
  (rmt:send-receive 'mark-incomplete run-id (list run-id ovr-deadtime))
  ) ;; )

(define (rmt:get-main-run-stats run-id)
  (rmt:send-receive 'get-main-run-stats #f (list run-id)))

(define (rmt:get-var varname)
  (rmt:send-receive 'get-var #f (list varname)))
(define (rmt:get-var run-id varname)
  (rmt:send-receive 'get-var run-id (list run-id varname)))

(define (rmt:del-var varname)
  (rmt:send-receive 'del-var #f (list varname)))
(define (rmt:del-var run-id varname)
  (rmt:send-receive 'del-var run-id (list run-id varname)))

(define (rmt:set-var varname value)
  (rmt:send-receive 'set-var #f (list varname value)))
(define (rmt:set-var run-id varname value)
  (rmt:send-receive 'set-var run-id (list run-id varname value)))

(define (rmt:inc-var varname)
  (rmt:send-receive 'inc-var #f (list varname)))
(define (rmt:inc-var run-id varname)
  (rmt:send-receive 'inc-var #f (list run-id varname)))

(define (rmt:dec-var varname)
  (rmt:send-receive 'dec-var #f (list varname)))
(define (rmt:dec-var run-id varname)
  (rmt:send-receive 'dec-var run-id (list run-id varname)))

(define (rmt:add-var varname value)
  (rmt:send-receive 'add-var #f (list varname value)))
(define (rmt:add-var run-id varname value)
  (rmt:send-receive 'add-var run-id (list run-id varname value)))

;;======================================================================
;; M U L T I R U N   Q U E R I E S
;;======================================================================

;; Need to move this to multi-run section and make associated changes
(define (rmt:find-and-mark-incomplete-all-runs #!key (ovr-deadtime #f))
1416
1417
1418
1419
1420
1421
1422
1423

1424
1425
1426
1427
1428
1429
1430

1431
1432
1433
1434
1435
1436
1437
1417
1418
1419
1420
1421
1422
1423

1424
1425
1426
1427
1428
1429
1430

1431
1432
1433
1434
1435
1436
1437
1438







-
+






-
+







	  (hash-table-set! *pre-reqs-met-cache* key (vector (current-seconds) newres))
	  newres))))

;;======================================================================
;; from metadat lookup MEGATEST_VERSION
;;
(define (common:get-last-run-version) ;; RADT => How does this work in send-receive function??; assume it is the value saved in some DB
  (rmt:get-var "MEGATEST_VERSION"))
  (rmt:get-var #f "MEGATEST_VERSION"))

(define (common:get-last-run-version-number)
  (string->number 
   (substring (common:get-last-run-version) 0 6)))

(define (common:set-last-run-version)
  (rmt:set-var "MEGATEST_VERSION" (common:version-signature)))
  (rmt:set-var #f "MEGATEST_VERSION" (common:version-signature)))

;;======================================================================
;; faux-lock is deprecated. Please use simple-lock below
;;
(define (common:faux-lock keyname #!key (wait-time 8)(allow-lock-steal #t))
  (if (rmt:no-sync-get/default keyname #f) ;; do not be tempted to compare to pid. locking is a one-shot action, if already locked for this pid it doesn't actually count
      (if (> wait-time 0)