Megatest

Check-in [931d0577a1]
Login
Overview
Comment:add to server file glob to skip server-kill match
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.6569-multi-db
Files: files | file ages | folders
SHA1: 931d0577a12af2d5eaf49924c42d90fd9274bdde
User & Date: matt on 2021-02-19 22:00:07
Other Links: branch diff | manifest | tags
Context
2021-02-19
23:44
Merged v1.6569-multi-db (which is actually modularization stuff) check-in: d983d860a1 user: matt tags: v1.65-real-new-runs-view
22:00
add to server file glob to skip server-kill match Leaf check-in: 931d0577a1 user: matt tags: v1.6569-multi-db
16:31
Added (declare (uses servermod)) and (import servermod) to fix megatest -cleanup-db check-in: 90ea1e537b user: mmgraham tags: v1.6569-multi-db
Changes

Modified servermod.scm from [467961a959] to [6b7ac0b729].

134
135
136
137
138
139
140
141

142
143
144
145
146
147
148
134
135
136
137
138
139
140

141
142
143
144
145
146
147
148







-
+







		(begin
		  (condition-case
		   (create-directory (conc areapath "/logs") #t)
		   (exn (i/o file)(debug:print 0 *default-log-port* "ERROR: Cannot create directory at " (conc areapath "/logs")))
		   (exn ()(debug:print 0 *default-log-port* "ERROR: Unknown error attemtping to get server list. exn=" exn)))
		  (directory-exists? (conc areapath "/logs")))
		'()))
	(let* ((server-logs   (glob (conc areapath "/logs/server-*.log")))
	(let* ((server-logs   (glob (conc areapath "/logs/server-[0-9]*.log")))
	       (num-serv-logs (length server-logs)))
	  (if (null? server-logs)
	      '()
	      (let loop ((hed  (car server-logs))
			 (tal  (cdr server-logs))
			 (res '()))
		(let* ((mod-time  (handle-exceptions

Modified tasks.scm from [ae153a5943] to [2d959c8f92].

503
504
505
506
507
508
509
510
511
512
513
514
515










516
517
518
519


520
521
522
523
524
525
526
503
504
505
506
507
508
509






510
511
512
513
514
515
516
517
518
519
520
521


522
523
524
525
526
527
528
529
530







-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+


-
-
+
+







			 param-key state-patt action-patt test-patt)))))

(define (tasks:find-task-queue-records dbstruct target run-name test-patt state-patt action-patt)
  ;; (handle-exceptions
  ;;  exn
  ;;  '()
  ;;  (sqlite3:first-row
  (let ((db  (db:get-db dbstruct))
	(res '()))
    (sqlite3:for-each-row 
     (lambda (a . b)
       (set! res (cons (cons a b) res)))
     db "SELECT id,action,owner,state,target,name,testpatt,keylock,params FROM tasks_queue 
  (let (;; (db  (db:get-db dbstruct))
  	(res '()))
    (db:with-db
     dbstruct #f #t
     (lambda (db)
       (sqlite3:for-each-row 
	(lambda (a . b)
	  (set! res (cons (cons a b) res)))
	db
	"SELECT id,action,owner,state,target,name,testpatt,keylock,params FROM tasks_queue 
           WHERE
              target = ? AND name = ? AND state LIKE ? AND action LIKE ? AND testpatt LIKE ?;"
     target run-name state-patt action-patt test-patt)
    res)) ;; )
	target run-name state-patt action-patt test-patt)
       res)))) ;; )

;; kill any runner processes (i.e. processes handling -runtests) that match target/runname
;; 
;; do a remote call to get the task queue info but do the killing as self here.
;;
(define (tasks:kill-runner target run-name testpatt)
  (let ((records    (rmt:tasks-find-task-queue-records target run-name testpatt "running" "run-tests"))