Megatest

Check-in [ef011a974f]
Login
Overview
Comment:Merged in debug improvement, debug is now passed on to the test execution
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: ef011a974fbdb2ad21bd1b7432b2dacc4461fc14
User & Date: mrwellan on 2012-04-02 09:09:07
Other Links: manifest | tags
Context
2012-04-02
09:19
Cache run info check-in: fa2b98fd70 user: mrwellan tags: trunk
09:09
Merged in debug improvement, debug is now passed on to the test execution check-in: ef011a974f user: mrwellan tags: trunk
01:47
Added info print to help resolve links vs. run area check-in: e1b6d511c2 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
Changes

Modified launch.scm from [8808c31a38] to [c6d7662106].

514
515
516
517
518
519
520
521


522
523
524
525
526
527
528
514
515
516
517
518
519
520

521
522
523
524
525
526
527
528
529







-
+
+







	 (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*))
551
552
553
554
555
556
557

558

559

560

561
562

563

564
565
566
567
568
569
570
552
553
554
555
556
557
558
559

560
561
562

563
564
565
566

567
568
569
570
571
572
573
574







+
-
+

+
-
+


+
-
+







						   (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" '())))