297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
|
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
|
-
+
|
;; The runconfigs.config file
;;
(define (rconfig)
(iup:vbox
(iup:frame #:title "Default")))
;;======================================================================
;; tree stuff
;; T R E E S T U F F
;;======================================================================
;; path is a list of nodes, each the child of the previous
;; this routine returns the id so another node can be added
;; either as a leaf or as a branch
;;
;; BUG: This needs a stop sensor for when a branch is exhausted
|
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
|
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
|
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
+
+
+
+
+
+
|
#t
;; reset to top
(loop (car nodelst)(cdr nodelst) 1 (list top))))
(if (null? tal) ;; if null here then this path has already been added
#t
(loop (car tal)(cdr tal)(+ depth 1) newpath))))))))
(define (tree-node->path obj nodenum)
;; (print "\ncurrnode nodenum depth node-depth node-title path")
(let loop ((currnode 0)
(depth 0)
(path '()))
(let ((node-depth (iup:attribute obj (conc "DEPTH" currnode)))
(node-title (iup:attribute obj (conc "TITLE" currnode))))
;; (display (conc "\n "currnode " " nodenum " " depth " " node-depth " " node-title " " path))
(if (> currnode nodenum)
path
(if (not node-depth) ;; #f if we are out of nodes
'()
(let ((ndepth (string->number node-depth)))
(if (eq? ndepth depth)
;; This next is the match condition depth == node-depth
(if (eq? currnode nodenum)
(begin
;; (display " <X>")
(append path (list node-title)))
(loop (+ currnode 1)
(+ depth 1)
(append path (list node-title))))
;; didn't match, reset to base path and keep looking
;; due to more iup odditys we don't reset to base
(begin
;; (display " <L>")
(loop (+ 1 currnode)
2
(append (take path ndepth)(list node-title)))))))))))
;;======================================================================
;; T E S T S
;;======================================================================
;; Test browser
(define (tests)
(iup:hbox
(let* ((tb (iup:treebox
#:selection_cb (lambda (obj id state)
(print "obj: " obj ", id: " id ", state: " state)))))
#:selection-cb (lambda (obj id state)
(print "obj: " obj ", id: " id ", state: " state)
(print "path: " (tree-node->path obj id))))))
(iup:attribute-set! tb "VALUE" "0")
(iup:attribute-set! tb "NAME" "Runs")
(iup:attribute-set! tb "ADDEXPANDED" "NO")
(dboard:data-set-tests-tree! *data* tb)
tb)
(iup:vbox
)))
;;======================================================================
;; R U N C O N T R O L
;;======================================================================
;; Overall runs browser
;;
(define (runs)
(let* ((runs-matrix (iup:matrix
#:expand "YES"
;; #:fittosize "YES"
#:scrollbar "YES"
|
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
|
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
|
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
|
runs-matrix)))))
;; Browse and control a single run
;;
(define (runcontrol)
(iup:hbox))
;; Main Panel
(define (main-panel)
(iup:dialog
#:title "Megatest Control Panel"
#:menu (main-menu)
(let ((tabtop (iup:tabs
(runs)
(tests)
(runcontrol)
(mtest)
(rconfig)
)))
(iup:attribute-set! tabtop "TABTITLE0" "Runs")
(iup:attribute-set! tabtop "TABTITLE1" "Tests")
(iup:attribute-set! tabtop "TABTITLE2" "Run Control")
(iup:attribute-set! tabtop "TABTITLE3" "megatest.config")
(iup:attribute-set! tabtop "TABTITLE4" "runconfigs.config")
tabtop)))
;; Process runs
;; P R O C E S S R U N S
;;======================================================================
;; MOVE THIS INTO *data*
(define *cachedata* (make-hash-table))
(hash-table-set! *cachedata* "runid-to-col" (make-hash-table))
(hash-table-set! *cachedata* "testname-to-row" (make-hash-table))
|
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
|
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
|
+
+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
run-ids)
(iup:attribute-set! (dboard:data-get-runs-matrix *data*) "REDRAW" "ALL")
;; (debug:print 2 "run-changes: " run-changes)
;; (debug:print 2 "test-changes: " test-changes)
(list run-changes test-changes)))
;;======================================================================
;; D A S H B O A R D
;;======================================================================
;;
|