Megatest

Diff
Login

Differences From Artifact [41259c2446]:

To Artifact [ec19d61978]:


263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
      (let* ((test-record (hash-table-ref test-records hed))
	     (tconfig     (tests:testqueue-get-testconfig test-record))
	     (waitons     (tests:testqueue-get-waitons    test-record))
	     (priority    (tests:testqueue-get-priority   test-record))
	     (itemdat     (tests:testqueue-get-itemdat    test-record))
	     (items       (tests:testqueue-get-items      test-record))
	     (item-path   (item-list->path itemdat)))
	(debug:print 0 "WHERE TO DO: (items:get-items-from-config config)")
	(debug:print 6
		     "itemdat:     " itemdat
		     "\n  items:     " items
		     "\n  item-path: " item-path)
	(cond
	 ((not items) ;; when false the test is ok to be handed off to launch (but not before)
	  (let ((have-resources  (runs:can-run-more-tests db test-record)) ;; look at the test jobgroup and tot jobs running







<







263
264
265
266
267
268
269

270
271
272
273
274
275
276
      (let* ((test-record (hash-table-ref test-records hed))
	     (tconfig     (tests:testqueue-get-testconfig test-record))
	     (waitons     (tests:testqueue-get-waitons    test-record))
	     (priority    (tests:testqueue-get-priority   test-record))
	     (itemdat     (tests:testqueue-get-itemdat    test-record))
	     (items       (tests:testqueue-get-items      test-record))
	     (item-path   (item-list->path itemdat)))

	(debug:print 6
		     "itemdat:     " itemdat
		     "\n  items:     " items
		     "\n  item-path: " item-path)
	(cond
	 ((not items) ;; when false the test is ok to be handed off to launch (but not before)
	  (let ((have-resources  (runs:can-run-more-tests db test-record)) ;; look at the test jobgroup and tot jobs running
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367


368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
  (let* ((test-name    (tests:testqueue-get-testname   test-record))
	 (test-waitons (tests:testqueue-get-waitons    test-record))
	 (test-conf    (tests:testqueue-get-testconfig test-record))
	 (itemdat      (tests:testqueue-get-itemdat    test-record))
	 (test-path    (conc *toppath* "/tests/" test-name)) ;; could use test:get-testconfig here ...
	 (force        (hash-table-ref/default flags "-force" #f))
	 (rerun        (hash-table-ref/default flags "-rerun" #f))
	 (keepgoing    (hash-table-ref/default flags "-keepgoing" #f)))
    (debug:print 1 "Launching test " test-name)
    (debug:print 5
		 "test-config: " (hash-table->alist test-conf)
		 "\n   itemdat: " itemdat
		 )
    ;; setting itemdat to a list if it is #f
    (if (not itemdat)(set! itemdat '()))


    (setenv "MT_TEST_NAME" test-name) ;; 
    (setenv "MT_RUNNAME"   runname)
    (set-megatest-env-vars db run-id) ;; these may be needed by the launching process
    (change-directory *toppath*)

    ;; Here is where the test_meta table is best updated
    (runs:update-test_meta db test-name test-conf)
    
    ;; (lambda (itemdat) ;;; ((ripeness "overripe") (temperature "cool") (season "summer"))
    (let* ((item-path     (item-list->path itemdat)) ;; (string-intersperse (map cadr itemdat) "/"))
	   (new-test-path (string-intersperse (cons test-path (map cadr itemdat)) "/"))
	   (new-test-name (if (equal? item-path "") test-name (conc test-name "/" item-path))) ;; just need it to be unique
	   (testdat       (db:get-test-info db run-id test-name item-path)))
      (if (not testdat)
	  (begin
	    (register-test db run-id test-name item-path)
	    (set! testdat (db:get-test-info db run-id test-name item-path))))
      (change-directory test-path)







|
|






>
>









<
|







352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377

378
379
380
381
382
383
384
385
  (let* ((test-name    (tests:testqueue-get-testname   test-record))
	 (test-waitons (tests:testqueue-get-waitons    test-record))
	 (test-conf    (tests:testqueue-get-testconfig test-record))
	 (itemdat      (tests:testqueue-get-itemdat    test-record))
	 (test-path    (conc *toppath* "/tests/" test-name)) ;; could use test:get-testconfig here ...
	 (force        (hash-table-ref/default flags "-force" #f))
	 (rerun        (hash-table-ref/default flags "-rerun" #f))
	 (keepgoing    (hash-table-ref/default flags "-keepgoing" #f))
	 (item-path     ""))
    (debug:print 5
		 "test-config: " (hash-table->alist test-conf)
		 "\n   itemdat: " itemdat
		 )
    ;; setting itemdat to a list if it is #f
    (if (not itemdat)(set! itemdat '()))
    (set! item-path (item-list->path itemdat))
    (debug:print 1 "Attempting to launch test " test-name "/" item-path)
    (setenv "MT_TEST_NAME" test-name) ;; 
    (setenv "MT_RUNNAME"   runname)
    (set-megatest-env-vars db run-id) ;; these may be needed by the launching process
    (change-directory *toppath*)

    ;; Here is where the test_meta table is best updated
    (runs:update-test_meta db test-name test-conf)
    
    ;; (lambda (itemdat) ;;; ((ripeness "overripe") (temperature "cool") (season "summer"))

    (let* ((new-test-path (string-intersperse (cons test-path (map cadr itemdat)) "/"))
	   (new-test-name (if (equal? item-path "") test-name (conc test-name "/" item-path))) ;; just need it to be unique
	   (testdat       (db:get-test-info db run-id test-name item-path)))
      (if (not testdat)
	  (begin
	    (register-test db run-id test-name item-path)
	    (set! testdat (db:get-test-info db run-id test-name item-path))))
      (change-directory test-path)