2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
2547
2548
2549
2550
2551
2552
2553
2554
2555
2556
2557
2558
2559
2560
2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
|
(if has-subrun
(iup:menu-item
"Launch subrun dashboard"
#:action
(lambda (obj)
(subrun:launch-dashboard rundir)))
(iup:vbox)))
(iup:menu-item
"Run"
(iup:menu
(iup:menu-item
(conc "Rerun " testpatt)
#:action
(lambda (obj)
;; (print " run-id: " run-id " test-id: " test-id " target: " target " runname: " runname " test-name: " test-name " testpatt: " testpatt "item-path : " item-path)
(common:run-a-command
(conc "megatest -run -target " target
" -runname " runname
" -testpatt " testpatt
" -preclean -clean-cache")
)))
(iup:menu-item
"Rerun Complete Run"
#:action
(lambda (obj)
(common:run-a-command
(conc "megatest -set-state-status NOT_STARTED,n/a -run -target " target
" -runname " runname
" -testpatt % "
" -preclean -clean-cache"))))
(iup:menu-item
"Clean Complete Run"
#:action
(lambda (obj)
(common:run-a-command
(conc "megatest -remove-runs -target " target
" -runname " runname
" -testpatt % "))))
(iup:menu-item
"Kill Complete Run"
#:action
(lambda (obj)
(common:run-a-command
(conc "megatest -set-state-status KILLREQ,n/a -target " target
" -runname " runname
" -testpatt % "
" -state RUNNING,REMOTEHOSTSTART,LAUNCHED,NOT_STARTED"))))
(iup:menu-item
"Delete Run Data"
#:action
(lambda (obj)
(common:run-a-command
(conc "megatest -remove-runs -target " target
" -runname " runname
" -testpatt % "
" -keep-records"))))))
(iup:menu-item
"Test"
(iup:menu
(iup:menu-item
(conc "Rerun " item-test-path)
#:action
(lambda (obj)
(common:run-a-command
(conc "megatest -set-state-status NOT_STARTED,n/a -run -target " target
" -runname " runname
" -testpatt " item-test-path
" -preclean -clean-cache"))))
(iup:menu-item
(conc "Kill " item-test-path)
#:action
(lambda (obj)
;; (rmt:test-set-state-status-by-id run-id test-id "KILLREQ" #f #f)
(common:run-a-command
(conc "megatest -set-state-status KILLREQ,n/a -target " target
" -runname " runname
" -testpatt " item-test-path
" -state RUNNING,REMOTEHOSTSTART,LAUNCHED"))))
(iup:menu-item
(conc "Delete data : " item-test-path)
#:action
(lambda (obj)
(common:run-a-command
(conc "megatest -remove-runs -target " target
" -runname " runname
" -testpatt " item-test-path
" -keep-records"))))
(iup:menu-item
(conc "Clean "item-test-path)
#:action
(lambda (obj)
(common:run-a-command
(conc "megatest -remove-runs -target " target
" -runname " runname
" -testpatt " item-test-path))))
(iup:menu-item
"Start xterm"
#:action
(lambda (obj)
(dcommon:examine-xterm run-id test-id)))
;;(let* ((cmd (conc (car (argv)) " -xterm " run-id "," test-id "&")))
;; (system cmd))))
(iup:menu-item
"Edit testconfig"
#:action
(lambda (obj)
(let* ((all-tests (tests:get-all))
(editor-rx (or (configf:lookup *configdat* "setup" "editor-regex")
"\\b(vim?|nano|pico)\\b"))
(editor (or (configf:lookup *configdat* "setup" "editor")
(get-environment-variable "VISUAL")
(get-environment-variable "EDITOR") "vi"))
(tconfig (conc (hash-table-ref all-tests test-name) "/testconfig"))
(cmd (conc (if (string-search editor-rx editor)
(conc "xterm -e " editor)
editor)
" " tconfig " &")))
(system cmd))))
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
>
|
|
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
2547
2548
2549
2550
2551
2552
2553
2554
2555
2556
2557
2558
2559
2560
2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
|
(if has-subrun
(iup:menu-item
"Launch subrun dashboard"
#:action
(lambda (obj)
(subrun:launch-dashboard rundir)))
(iup:vbox)))
(let* ((run-menu-items
(list
(iup:menu-item
(conc "Rerun " testpatt)
#:action
(lambda (obj)
;; (print " run-id: " run-id " test-id: " test-id " target: " target " runname: " runname " test-name: " test-name " testpatt: " testpatt "item-path : " item-path)
(common:run-a-command
(conc "megatest -run -target " target
" -runname " runname
" -testpatt " testpatt
" -preclean -clean-cache")
)))
(iup:menu-item
"Rerun Complete Run"
#:action
(lambda (obj)
(common:run-a-command
(conc "megatest -set-state-status NOT_STARTED,n/a -run -target " target
" -runname " runname
" -testpatt % "
" -preclean -clean-cache"))))
(iup:menu-item
"Clean Complete Run"
#:action
(lambda (obj)
(common:run-a-command
(conc "megatest -remove-runs -target " target
" -runname " runname
" -testpatt % "))))
(iup:menu-item
"Kill Complete Run"
#:action
(lambda (obj)
(common:run-a-command
(conc "megatest -set-state-status KILLREQ,n/a -target " target
" -runname " runname
" -testpatt % "
" -state RUNNING,REMOTEHOSTSTART,LAUNCHED,NOT_STARTED"))))
(iup:menu-item
"Delete Run Data"
#:action
(lambda (obj)
(common:run-a-command
(conc "megatest -remove-runs -target " target
" -runname " runname
" -testpatt % "
" -keep-records"))))))
(test-menu-items
(iup:menu-item
(conc "Rerun " item-test-path)
#:action
(lambda (obj)
(common:run-a-command
(conc "megatest -set-state-status NOT_STARTED,n/a -run -target " target
" -runname " runname
" -testpatt " item-test-path
" -preclean -clean-cache"))))
(iup:menu-item
(conc "Kill " item-test-path)
#:action
(lambda (obj)
;; (rmt:test-set-state-status-by-id run-id test-id "KILLREQ" #f #f)
(common:run-a-command
(conc "megatest -set-state-status KILLREQ,n/a -target " target
" -runname " runname
" -testpatt " item-test-path
" -state RUNNING,REMOTEHOSTSTART,LAUNCHED"))))
(iup:menu-item
(conc "Delete data : " item-test-path)
#:action
(lambda (obj)
(common:run-a-command
(conc "megatest -remove-runs -target " target
" -runname " runname
" -testpatt " item-test-path
" -keep-records"))))
(iup:menu-item
(conc "Clean "item-test-path)
#:action
(lambda (obj)
(common:run-a-command
(conc "megatest -remove-runs -target " target
" -runname " runname
" -testpatt " item-test-path))))
(iup:menu-item
"Start xterm"
#:action
(lambda (obj)
(dcommon:examine-xterm run-id test-id)))
;;(let* ((cmd (conc (car (argv)) " -xterm " run-id "," test-id "&")))
;; (system cmd))))
(iup:menu-item
"Edit testconfig"
#:action
(lambda (obj)
(let* ((all-tests (tests:get-all))
(editor-rx (or (configf:lookup *configdat* "setup" "editor-regex")
"\\b(vim?|nano|pico)\\b"))
(editor (or (configf:lookup *configdat* "setup" "editor")
(get-environment-variable "VISUAL")
(get-environment-variable "EDITOR") "vi"))
(tconfig (conc (hash-table-ref all-tests test-name) "/testconfig"))
(cmd (conc (if (string-search editor-rx editor)
(conc "xterm -e " editor)
editor)
" " tconfig " &")))
(system cmd)))))
(custom-menu-items (dashboard:get-custom-menu-items *configdat*))
)
(iup:menu-item
"Run"
(apply iup:menu run-menu-items))
(iup:menu-item
"Test"
(apply iup:menu test-menu-items))
)
))))
(define (make-dashboard-buttons commondat) ;; runs-sum-dat new-view-dat)
(let* ((stats-dat (dboard:tabdat-make-data))
|