Changes In Branch ezsteps-refactor Excluding Merge-Ins
This is equivalent to a diff from 37efe35171 to 5b3294f8c9
2015-04-01
| ||
01:20 | Merged in ezsteps refactor branch check-in: db2ccc3980 user: matt tags: v1.60 | |
01:19 | Fixed process killing? Closed-Leaf check-in: 5b3294f8c9 user: matt tags: ezsteps-refactor | |
00:08 | Added temp test for looking at failed killing of jobs check-in: 9fc571c903 user: matt tags: ezsteps-refactor | |
2015-03-31
| ||
22:55 | Partial removal of bash script for ezsteps check-in: 437eaccb58 user: matt tags: ezsteps-refactor | |
08:24 | Added makefile to batchsim check-in: 37efe35171 user: mrwellan tags: v1.60 | |
2015-03-30
| ||
22:49 | Improved recovery when communications goes bad in http transport check-in: 2c6622a2b7 user: matt tags: v1.60 | |
Modified launch.scm from [2480988c90] to [492563d3d0].
︙ | |||
9 10 11 12 13 14 15 | 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 | - + + | ;; PURPOSE. ;;====================================================================== ;; launch a task - this runs on the originating host, tests themselves ;; ;;====================================================================== |
︙ | |||
49 50 51 52 53 54 55 56 57 58 59 60 61 62 | 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 | + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + | ;; if handed a string, process it, else look for MT_CMDINFO (define (launch:get-cmdinfo-assoc-list #!key (encoded-cmd #f)) (let ((enccmd (if encoded-cmd encoded-cmd (getenv "MT_CMDINFO")))) (if enccmd (common:read-encoded-string enccmd) '()))) (define (launch:runstep ezstep run-id test-id exit-info m tal) (let* ((stepname (car ezstep)) ;; do stuff to run the step (stepinfo (cadr ezstep)) (stepparts (string-match (regexp "^(\\{([^\\}]*)\\}\\s*|)(.*)$") stepinfo)) (stepparms (list-ref stepparts 2)) ;; for future use, {VAR=1,2,3}, run step for each (stepcmd (list-ref stepparts 3)) (script "") ; "#!/bin/bash\n") ;; yep, we depend on bin/bash FIXME!!!\ (logpro-file (conc stepname ".logpro")) (html-file (conc stepname ".html")) (logpro-used (file-exists? logpro-file))) ;; NB// can safely assume we are in test-area directory (debug:print 4 "ezsteps:\n stepname: " stepname " stepinfo: " stepinfo " stepparts: " stepparts " stepparms: " stepparms " stepcmd: " stepcmd) ;; ;; first source the previous environment ;; (let ((prev-env (conc ".ezsteps/" prevstep (if (string-search (regexp "csh") ;; (get-environment-variable "SHELL")) ".csh" ".sh")))) ;; (if (and prevstep (file-exists? prev-env)) ;; (set! script (conc script "source " prev-env)))) ;; call the command using mt_ezstep ;; (set! script (conc "mt_ezstep " stepname " " (if prevstep prevstep "x") " " stepcmd)) (debug:print 4 "script: " script) (rmt:teststep-set-status! run-id test-id stepname "start" "-" #f #f) ;; now launch the actual process (call-with-environment-variables (list (cons "PATH" (conc (get-environment-variable "PATH") ":."))) (lambda () (let* ((cmd (conc stepcmd " > " stepname ".log")) (pid (process-run cmd))) (rmt:test-set-top-process-pid run-id test-id pid) (let processloop ((i 0)) (let-values (((pid-val exit-status exit-code)(process-wait pid #t))) (mutex-lock! m) (vector-set! exit-info 0 pid) (vector-set! exit-info 1 exit-status) (vector-set! exit-info 2 exit-code) (mutex-unlock! m) (if (eq? pid-val 0) (begin (thread-sleep! 2) (processloop (+ i 1)))) ))))) (debug:print-info 0 "step " stepname " completed with exit code " (vector-ref exit-info 2)) ;; now run logpro if needed (if logpro-used (let ((pid (process-run (conc "logpro " logpro-file " " (conc stepname ".html") " < " stepname ".log")))) (let processloop ((i 0)) (let-values (((pid-val exit-status exit-code)(process-wait pid #t))) (mutex-lock! m) (vector-set! exit-info 0 pid) (vector-set! exit-info 1 exit-status) (vector-set! exit-info 2 exit-code) (mutex-unlock! m) (if (eq? pid-val 0) (begin (thread-sleep! 2) (processloop (+ i 1))))) (debug:print-info 0 "logpro for step " stepname " exited with code " (vector-ref exit-info 2))))) (let ((exinfo (vector-ref exit-info 2)) (logfna (if logpro-used (conc stepname ".html") ""))) (rmt:teststep-set-status! run-id test-id stepname "end" exinfo #f logfna)) (if logpro-used (rmt:test-set-log! run-id test-id (conc stepname ".html"))) ;; set the test final status (let* ((this-step-status (cond ((and (eq? (vector-ref exit-info 2) 2) logpro-used) 'warn) ((eq? (vector-ref exit-info 2) 0) 'pass) (else 'fail))) (overall-status (cond ((eq? (vector-ref exit-info 3) 2) 'warn) ;; rollup-status ((eq? (vector-ref exit-info 3) 0) 'pass) (else 'fail))) (next-status (cond ((eq? overall-status 'pass) this-step-status) ((eq? overall-status 'warn) (if (eq? this-step-status 'fail) 'fail 'warn)) (else 'fail))) (next-state ;; "RUNNING") ;; WHY WAS THIS CHANGED TO NOT USE (null? tal) ?? (cond ((null? tal) ;; more to run? "COMPLETED") (else "RUNNING"))) ) (debug:print 4 "Exit value received: " (vector-ref exit-info 2) " logpro-used: " logpro-used " this-step-status: " this-step-status " overall-status: " overall-status " next-status: " next-status " rollup-status: " (vector-ref exit-info 3)) (case next-status ((warn) (vector-set! exit-info 3 2) ;; rollup-status ;; NB// test-set-status! does rdb calls under the hood (tests:test-set-status! run-id test-id next-state "WARN" (if (eq? this-step-status 'warn) "Logpro warning found" #f) #f)) ((pass) (tests:test-set-status! run-id test-id next-state "PASS" #f #f)) (else ;; 'fail (vector-set! exit-info 3 1) ;; force fail, this used to be next-state but that doesn't make sense. should always be "COMPLETED" (tests:test-set-status! run-id test-id "COMPLETED" "FAIL" (conc "Failed at step " stepname) #f) ))) logpro-used)) (define (launch:execute encoded-cmd) (let* ((cmdinfo (common:read-encoded-string encoded-cmd))) (setenv "MT_CMDINFO" encoded-cmd) (if (list? cmdinfo) ;; ((testpath /tmp/mrwellan/jazzmind/src/example_run/tests/sqlitespeed) ;; (test-name sqlitespeed) (runscript runscript.rb) (db-host localhost) (run-id 1)) (let* ((testpath (assoc/default 'testpath cmdinfo)) ;; testpath is the test spec area (top-path (assoc/default 'toppath cmdinfo)) |
︙ | |||
86 87 88 89 90 91 92 | 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 | - + + | (if (substring-index "/" runscript) runscript ;; use unadultered if contains slashes (let ((fulln (conc testpath "/" runscript))) (if (and (file-exists? fulln) (file-execute-access? fulln)) fulln runscript))))) ;; assume it is on the path |
︙ | |||
195 196 197 198 199 200 201 | 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 | - + - + - + - + | ;; We are about to actually kick off the test ;; so this is a good place to remove the records for ;; any previous runs ;; (db:test-remove-steps db run-id testname itemdat) (let* ((m (make-mutex)) (kill-job? #f) |
︙ | |||
246 247 248 249 250 251 252 | 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 | - - - - - - - - - - - + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | (if (not (> (length ezstepslst) 0)) (debug:print 0 "ERROR: ezsteps defined but ezstepslst is zero length") (let loop ((ezstep (car ezstepslst)) (tal (cdr ezstepslst)) (prevstep #f)) ;; check exit-info (vector-ref exit-info 1) (if (vector-ref exit-info 1) |
︙ | |||
372 373 374 375 376 377 378 | 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 | + - - - - - - + + + + + + + + + + + + + + | (lambda (pid) (handle-exceptions exn (begin (debug:print-info 0 "Unable to kill process with pid " pid ", possibly already killed.") (debug:print 0 " message: " ((condition-property-accessor 'exn 'message) exn))) (debug:print 0 "WARNING: Request received to kill job " pid) ;; " (attempt # " kill-tries ")") (debug:print-info 0 "Signal mask=" (signal-mask)) |
︙ | |||
415 416 417 418 419 420 421 | 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 | - + - - + + - + | (if (member (db:test-get-state testinfo) '("REMOTEHOSTSTART" "RUNNING")) ;; NOTE: It should *not* be REMOTEHOSTSTART but for reasons I don't yet understand it sometimes gets stuck in that state ;; (not (equal? (db:test-get-state testinfo) "COMPLETED")) (let ((new-state (if kill-job? "KILLED" "COMPLETED") ;; (if (eq? (vector-ref exit-info 2) 0) ;; exited with "good" status ;; "COMPLETED" ;; (db:test-get-state testinfo))) ;; else preseve the state as set within the test ) (new-status (cond ((not (vector-ref exit-info 1)) "FAIL") ;; job failed to run |
︙ |
Modified process.scm from [13bb37a3d1] to [785bc2c6db].
︙ | |||
9 10 11 12 13 14 15 16 17 18 19 20 21 22 | 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 | + | ;; PURPOSE. ;;====================================================================== ;;====================================================================== ;; Process convience utils ;;====================================================================== (use regex) (declare (unit process)) (declare (uses common)) (define (conservative-read port) (let loop ((res "")) (if (not (eof-object? (peek-char port))) (loop (conc res (read-char port))) |
︙ | |||
145 146 147 148 149 150 151 | 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 | + + + + + + + + + + + + | exn ;; possibly pid is a process not a child, look in /proc to see if it is running still (file-exists? (conc "/proc/" pid)) (let-values (((rpid exit-type exit-signal)(process-wait pid #t))) (and (number? rpid) (equal? rpid pid))))) (define (process:get-sub-pids pid) (with-input-from-pipe (conc "pstree -A -p " pid) ;; | tr 'a-z\\-+`()\\.' ' ' " pid) (lambda () (let loop ((inl (read-line)) (res '())) (if (eof-object? inl) (reverse res) (let ((nums (map string->number (string-split-fields "\\d+" inl)))) (loop (read-line) (append res nums)))))))) |
Modified tests/fullrun/tests/runfirst/main.sh from [f50c79a657] to [10c2d3cd04].
1 | 1 2 3 4 5 6 7 8 9 | - + | #!/bin/bash |
︙ |