488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
|
(dashboard-tests:run-html-viewer lfilename)
(message-window (conc "File " lfilename " not found"))))))
(xterm (lambda (x)
(if (directory-exists? rundir)
(let ((shell (if (get-environment-variable "SHELL")
(conc "-e " (get-environment-variable "SHELL"))
"")))
(system (conc "cd " rundir
";mt_xterm -T \"" (string-translate testfullname "()" " ") "\" " shell "&")))
(message-window (conc "Directory " rundir " not found")))))
(widgets (make-hash-table))
(refreshdat (lambda ()
(let* ((curr-mod-time (file-modification-time db-path))
;; (max ..... (if (file-exists? testdat-path)
;; (file-modification-time testdat-path)
;; (begin
|
>
|
|
>
|
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
|
(dashboard-tests:run-html-viewer lfilename)
(message-window (conc "File " lfilename " not found"))))))
(xterm (lambda (x)
(if (directory-exists? rundir)
(let ((shell (if (get-environment-variable "SHELL")
(conc "-e " (get-environment-variable "SHELL"))
"")))
(common:without-vars
(conc "cd " rundir
";mt_xterm -T \"" (string-translate testfullname "()" " ") "\" " shell "&")
"MT_.*"))
(message-window (conc "Directory " rundir " not found")))))
(widgets (make-hash-table))
(refreshdat (lambda ()
(let* ((curr-mod-time (file-modification-time db-path))
;; (max ..... (if (file-exists? testdat-path)
;; (file-modification-time testdat-path)
;; (begin
|
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
|
(begin
;(mutex-lock! mx1)
(iup:attribute-set! lbl "TITLE" newval)
;(mutex-unlock! mx1)
)))))
lbl))
(store-button store-label)
(command-text-box (iup:textbox #:expand "HORIZONTAL" #:font "Courier New, -10"))
(command-launch-button (iup:button "Execute!" #:action (lambda (x)
(let* ((cmd (iup:attribute command-text-box "VALUE"))
(fullcmd (conc (dtests:get-pre-command)
cmd
(dtests:get-post-command))))
(debug:print-info 02 "Running command: " fullcmd)
(system fullcmd)))))
(kill-jobs (lambda (x)
(iup:attribute-set!
command-text-box "VALUE"
(conc "megatest -target " keystring " -runname " runname
" -set-state-status KILLREQ,n/a -testpatt %/% "
" -state RUNNING"))))
(run-test (lambda (x)
|
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
|
|
|
|
|
|
|
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
|
(begin
;(mutex-lock! mx1)
(iup:attribute-set! lbl "TITLE" newval)
;(mutex-unlock! mx1)
)))))
lbl))
(store-button store-label)
(command-proc (lambda (command-text-box)
(let* ((cmd (iup:attribute command-text-box "VALUE"))
(fullcmd (conc (dtests:get-pre-command)
cmd
(dtests:get-post-command))))
(debug:print-info 02 "Running command: " fullcmd)
(common:without-vars fullcmd "MT_.*"))))
(command-text-box (iup:textbox
#:expand "HORIZONTAL"
#:font "Courier New, -10"
#:action (lambda (obj cnum val)
;; (print "cnum=" cnum)
(if (eq? cnum 13)
(command-prox obj)))
))
(command-launch-button (iup:button "Execute!" #:action (lambda (x)
(command-proc command-text-box))))
;; (lambda (x)
;; (let* ((cmd (iup:attribute command-text-box "VALUE"))
;; (fullcmd (conc (dtests:get-pre-command)
;; cmd
;; (dtests:get-post-command))))
;; (debug:print-info 02 "Running command: " fullcmd)
;; (common:without-vars fullcmd "MT_.*")))))
(kill-jobs (lambda (x)
(iup:attribute-set!
command-text-box "VALUE"
(conc "megatest -target " keystring " -runname " runname
" -set-state-status KILLREQ,n/a -testpatt %/% "
" -state RUNNING"))))
(run-test (lambda (x)
|
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
|
"%"
item-path))
";megatest -target " keystring " -runname " runname
" -runtests " (conc testname "/" (if (equal? item-path "")
"%"
item-path))
)))
(system (conc (dtests:get-pre-command)
cmd
(dtests:get-post-command))))))
(remove-test (lambda (x)
(iup:attribute-set!
command-text-box "VALUE"
(conc "megatest -remove-runs -target " keystring " -runname " runname
" -testpatt " (conc testname "/" (if (equal? item-path "")
"%"
item-path))
|
>
|
|
|
>
|
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
|
"%"
item-path))
";megatest -target " keystring " -runname " runname
" -runtests " (conc testname "/" (if (equal? item-path "")
"%"
item-path))
)))
(common:without-vars
(conc (dtests:get-pre-command)
cmd
(dtests:get-post-command))
"MT_.*"))))
(remove-test (lambda (x)
(iup:attribute-set!
command-text-box "VALUE"
(conc "megatest -remove-runs -target " keystring " -runname " runname
" -testpatt " (conc testname "/" (if (equal? item-path "")
"%"
item-path))
|