Megatest

Diff
Login

Differences From Artifact [8d5f3a1ead]:

To Artifact [84fbf4d5d8]:


351
352
353
354
355
356
357

358
359
360
361
362
363
364
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365







+







					(loop (car tal)(cdr tal)))
				    #f))))))
	    (pop-directory)
	    result)))))

(define (tests:test-force-state-status! run-id test-id state status)
  (rmt:test-set-status-state run-id test-id status state #f)
  ;; (rmt:roll-up-pass-fail-counts run-id test-name item
  (mt:process-triggers run-id test-id state status))

;; Do not rpc this one, do the underlying calls!!!
(define (tests:test-set-status! run-id test-id state status comment dat #!key (work-area #f))
  (let* ((real-status status)
	 (otherdat    (if dat dat (make-hash-table)))
	 (testdat     (rmt:get-test-info-by-id run-id test-id))
394
395
396
397
398
399
400
401


402
403
404
405
406
407
408
395
396
397
398
399
400
401

402
403
404
405
406
407
408
409
410







-
+
+








    (debug:print 4 *default-log-port* "real-status " real-status ", waived " waived ", status " status)

    ;; update the primary record IF state AND status are defined
    (if (and state status)
	(begin
	  (rmt:test-set-status-state run-id test-id real-status state (if waived waived comment))
	  (mt:process-triggers run-id test-id state real-status)))
	  (mt:process-triggers run-id test-id state real-status)
	  ))
    
    ;; if status is "AUTO" then call rollup (note, this one modifies data in test
    ;; run area, it does remote calls under the hood.
    (if (and test-id state status (equal? status "AUTO")) 
	(rmt:test-data-rollup run-id test-id status))

    ;; add metadata (need to do this way to avoid SQL injection issues)
439
440
441
442
443
444
445
446

447
448
449
450
451
452
453
441
442
443
444
445
446
447

448
449
450
451
452
453
454
455







-
+







			   type     )))
	    ;; This was run remote, don't think that makes sense. Perhaps not, but that is the easiest path for the moment.
	    (rmt:csv->test-data run-id test-id
				dat))))
      
    ;; need to update the top test record if PASS or FAIL and this is a subtest
    (if (not (equal? item-path ""))
	(rmt:roll-up-pass-fail-counts run-id test-name item-path state status))
	(rmt:roll-up-pass-fail-counts run-id test-name item-path state status #f))

    (if (or (and (string? comment)
		 (string-match (regexp "\\S+") comment))
	    waived)
	(let ((cmt  (if waived waived comment)))
	  (rmt:general-call 'set-test-comment run-id cmt test-id)))))

478
479
480
481
482
483
484
485

486
487
488
489
490
491
492
480
481
482
483
484
485
486

487
488
489
490
491
492
493
494







-
+







	(let ((my-start-time (current-seconds))
	      (lockf         (conc outputfilename ".lock")))
	  (let loop ((have-lock  (common:simple-file-lock lockf)))
	    (if have-lock
		(let ((script (configf:lookup *configdat* "testrollup" test-name)))
		  (print "Obtained lock for " outputfilename)
		  ;; (rmt:top-test-set-per-pf-counts run-id test-name)
		  (rmt:roll-up-pass-fail-counts run-id test-name "" #f #f)
		  (rmt:roll-up-pass-fail-counts run-id test-name "" #f #f #f)
		  (rmt:top-test-set-per-pf-counts run-id test-name)
		  (if script
		      (system (conc script " > " outputfilename " & "))
		      (tests:generate-html-summary-for-iterated-test run-id test-id test-name outputfilename))
		  (common:simple-file-release-lock lockf)
		  (change-directory orig-dir)
		  ;; NB// tests:test-set-toplog! is remote internal...