Megatest

Check-in [b73650afa1]
Login
Overview
Comment:Pass debug params to execute tests
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | pass-debug-to-test-execute
Files: files | file ages | folders
SHA1: b73650afa113eae149899d5d9779248c063bca1b
User & Date: mrwellan on 2012-04-01 23:14:13
Other Links: branch diff | manifest | tags
Context
2012-04-02
09:09
Merged in debug improvement, debug is now passed on to the test execution check-in: ef011a974f user: mrwellan tags: trunk
2012-04-01
23:14
Pass debug params to execute tests Closed-Leaf check-in: b73650afa1 user: mrwellan tags: pass-debug-to-test-execute
22:20
rundir and links fix check-in: 346409ed1e user: matt tags: trunk
Changes

Modified launch.scm from [290ef6c47a] to [d3204092b8].

478
479
480
481
482
483
484
485


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

485
486
487
488
489
490
491
492
493







-
+
+







	 (toptest-work-area #f) ;; for iterated tests the top test contains data relevant for all
	 (diskpath   #f)
	 (cmdparms   #f)
	 (fullcmd    #f) ;; (define a (with-output-to-string (lambda ()(write x))))
	 (mt-bindir-path #f)
	 (item-path (item-list->path itemdat))
	 (testinfo   (rdb:get-test-info db run-id test-name item-path))
	 (test-id    (db:test-get-id testinfo)))
	 (test-id    (db:test-get-id testinfo))
	 (debug-param (if (args:get-arg "-debug")(list "-debug" (args:get-arg "-debug")) '())))
  (if hosts (set! hosts (string-split hosts)))
    ;; set the megatest to be called on the remote host
    (if (not remote-megatest)(set! remote-megatest local-megatest)) ;; "megatest"))
    (set! mt-bindir-path (pathname-directory remote-megatest))
    (if launcher (set! launcher (string-split launcher)))
    ;; set up the run work area for this test
    (set! diskpath (get-best-disk *configdat*))
514
515
516
517
518
519
520

521

522

523

524
525

526

527
528
529
530
531
532
533
515
516
517
518
519
520
521
522

523
524
525

526
527
528
529

530
531
532
533
534
535
536
537







+
-
+

+
-
+


+
-
+







						   (list 'runname   runname)
						   (list 'mt-bindir-path mt-bindir-path))))))) ;; (string-intersperse keyvallst " "))))
    ;; clean out step records from previous run if they exist
    (db:delete-test-step-records db run-id test-name itemdat)
    (change-directory work-area) ;; so that log files from the launch process don't clutter the test dir
    (cond
     ((and launcher hosts) ;; must be using ssh hostname
      (set! fullcmd (append launcher (car hosts)(list remote-megatest test-sig "-execute" cmdparms) debug-param)))
      (set! fullcmd (append launcher (car hosts)(list remote-megatest test-sig "-execute" cmdparms))))
      ;; (set! fullcmd (append launcher (car hosts)(list remote-megatest test-sig "-execute" cmdparms))))
     (launcher
      (set! fullcmd (append launcher (list remote-megatest test-sig "-execute" cmdparms) debug-param)))
      (set! fullcmd (append launcher (list remote-megatest test-sig "-execute" cmdparms))))
      ;; (set! fullcmd (append launcher (list remote-megatest test-sig "-execute" cmdparms))))
     (else
      (if (not useshell)(debug:print 0 "WARNING: internal launching will not work well without \"useshell yes\" in your [jobtools] section"))
      (set! fullcmd (append (list remote-megatest test-sig "-execute" cmdparms) debug-param (list (if useshell "&" ""))))))
      (set! fullcmd (list remote-megatest test-sig "-execute" cmdparms (if useshell "&" "")))))
      ;; (set! fullcmd (list remote-megatest test-sig "-execute" cmdparms (if useshell "&" "")))))
    (if (args:get-arg "-xterm")(set! fullcmd (append fullcmd (list "-xterm"))))
    (debug:print 1 "Launching megatest for test " test-name " in " work-area" ...")
    (test-set-status! db test-id "LAUNCHED" "n/a" #f #f) ;; (if launch-results launch-results "FAILED"))
    ;; set pre-launch-env-vars before launching, keep the vars in prevvals and put the envionment back when done
    (debug:print 4 "fullcmd: " fullcmd)
    (let* ((commonprevvals (alist->env-vars
			    (hash-table-ref/default *configdat* "env-override" '())))