Megatest

Check-in [d90aea75ce]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Cleaned up tests dashboard.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: d90aea75cec9fe53e8c03f98d83621d31f2756fd
User & Date: mrwellan on 2011-09-12 19:58:27
Other Links: manifest | tags
Context
2011-09-12
23:23
rebuild-db now recursive until done. Added more fields to output of ods, added run id and grouped by testname check-in: cc39eeae62 user: matt tags: trunk
19:58
Cleaned up tests dashboard. check-in: d90aea75ce user: mrwellan tags: trunk
07:22
Minor clean up from merge check-in: f6a4f7080e user: matt tags: trunk
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified dashboard-tests.scm from [d136c6edce] to [eadc61709a].

︙
21
22
23
24
25
26
27
28

29
30
31
32
33
34
35
36
37
38
39

21
22
23
24
25
26
27

28




29
30
31
32
33
34
35








-
+
-
-
-
-








			  (iup:label val ; #:expand "HORIZONTAL"
				     ))
			(list "Testname: "
			      "Item path: "
			      "Current state: "
			      "Current status: "
			      "Test comment: "
			      "Test id: "
			      "Test id: "))
			      "Value: "
			      "Expected value: "
			      "Tolerance: "
			      "Units: "))
		   (list (iup:label "" #:expand "VERTICAL"))))
    (apply iup:vbox  ; #:expand "YES"
	   (list 
	    (store-label "testname"
			 (iup:label (db:test-get-testname  testdat) #:expand "HORIZONTAL")
			 (lambda (testdat)(db:test-get-testname testdat)))
	    (store-label "item-path"
︙
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93

56
57
58
59
60
61
62




















63
64
65
66
67
68
69








-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-








			 (lambda (testdat)
			   (db:test-get-comment testdat)))
	    (store-label "testid"
			 (iup:label "TestId                             "
				    #:expand "HORIZONTAL")
			 (lambda (testdat)
			   (db:test-get-id testdat)))
;;	    (store-label "testvalue"
;;			 (iup:label "TestValue                          "
;;				    #:expand "HORIZONTAL")
;;			 (lambda (testdat)
;;			   (db:test-get-value testdat)))
;;	    (store-label "testexpectedvalue"
;;			 (iup:label "TestExpectedValue                  "
;;				    #:expand "HORIZONTAL")
;;			 (lambda (testdat)
;;			   (db:test-get-expected_value testdat)))
;;	    (store-label "testtol"
;;			 (iup:label "TestTol                             "
;;				    #:expand "HORIZONTAL")
;;			 (lambda (testdat)
;;			   (db:test-get-tol testdat)))
;;	    (store-label "testunits"
;;			 (iup:label "TestUnits                          "
;;				    #:expand "HORIZONTAL")
;;			 (lambda (testdat)
;;			   (db:test-get-units testdat)))
	    )))))

;;======================================================================
;; Test meta panel
;;======================================================================
(define (test-meta-panel testmeta store-meta)
  (iup:frame
︙
344
345
346
347
348
349
350

351
352
353
354
355
356
357
358
359
360
361
362
363
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

320
321
322
323
324
325
326
327







































328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
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








+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+








	       ;; The controls
	       (iup:frame #:title "Actions" 
			  (iup:hbox 
			   (iup:button "View Log"    #:action viewlog #:size "120x")
			   (iup:button "Start Xterm" #:action xterm   #:size "120x")
			   (iup:button "Close"       #:action (lambda (x)(exit)) #:size "120x")))
	       (set-fields-panel test-id testdat)
	       (iup:hbox
	       (iup:frame 
		#:title "Test Steps"
		(let ((stepsdat ;;(iup:label "Test steps ........................................." 
				;;	   #:expand "YES" 
				;;	   #:size "200x150"
				;;	   #:alignment "ALEFT:ATOP")))
		       (iup:textbox #:action (lambda (obj char val)
					       #f)
				    #:expand "YES"
				    #:multiline "YES"
				    #:font "Courier New, -10")))
		  (hash-table-set! widgets "Test Steps" (lambda (testdat)
							  (let* ((currval (iup:attribute stepsdat "VALUE")) ;; "TITLE"))
								 (fmtstr  "~25a~10a~10a~15a~15a")
								 (comprsteps (db:get-steps-table db test-id))
								 (newval  (string-intersperse 
									   (append
									    (list 
									     (format #f fmtstr "Stepname" "Start" "End"    "Status" "Time")
									     (format #f fmtstr "========" "=====" "======" "======" "=========="))
									    (map (lambda (x)
										   ;; take advantage of the \n on time->string
										   (format #f fmtstr
											   (vector-ref x 0)
											   (let ((s (vector-ref x 1)))
											     (if (number? s)(seconds->time-string s) s))
											   (let ((s (vector-ref x 2)))
											     (if (number? s)(seconds->time-string s) s))
											   (vector-ref x 3)    ;; status
											   (vector-ref x 4)))  ;; time delta
										 (sort (hash-table-values comprsteps)
										       (lambda (a b)
											 (if (and (number? a)(number? b))
											     (< (vector-ref a 1)(vector-ref b 1))
											     #t)))))
									   "\n")))
							    (if (not (equal? currval newval))
								(iup:attribute-set! stepsdat "VALUE" newval ))))) ;; "TITLE" newval)))))
		  stepsdat)))))
		(iup:frame 
		 #:title "Test Steps"
		 (let ((stepsdat ;;(iup:label "Test steps ........................................." 
			;;	   #:expand "YES" 
			;;	   #:size "200x150"
			;;	   #:alignment "ALEFT:ATOP")))
			(iup:textbox #:action (lambda (obj char val)
						#f)
				     #:expand "YES"
				     #:multiline "YES"
				     #:font "Courier New, -10"
				     #:size "100x150")))
		   (hash-table-set! widgets "Test Steps" 
				    (lambda (testdat)
				      (let* ((currval (iup:attribute stepsdat "VALUE")) ;; "TITLE"))
					     (fmtstr  "~20a~10a~10a~12a~15a")
					     (comprsteps (db:get-steps-table db test-id))
					     (newval  (string-intersperse 
						       (append
							(list 
							 (format #f fmtstr "Stepname" "Start" "End" "Status" "Time")
							 (format #f fmtstr "========" "=====" "===" "======" "===="))
							(map (lambda (x)
							       ;; take advantage of the \n on time->string
							       (format #f fmtstr
								       (vector-ref x 0)
								       (let ((s (vector-ref x 1)))
									 (if (number? s)(seconds->time-string s) s))
								       (let ((s (vector-ref x 2)))
									 (if (number? s)(seconds->time-string s) s))
								       (vector-ref x 3)    ;; status
								       (vector-ref x 4)))  ;; time delta
							     (sort (hash-table-values comprsteps)
								   (lambda (a b)
								     (if (and (number? a)(number? b))
									 (< (vector-ref a 1)(vector-ref b 1))
									 #t)))))
						       "\n")))
					(if (not (equal? currval newval))
					    (iup:attribute-set! stepsdat "VALUE" newval ))))) ;; "TITLE" newval)))))
		   stepsdat))
		;; populate the Test Data panel
		(iup:frame
		 #:title "Test Data"
		 (let ((test-data
			(iup:textbox  #:action (lambda (obj char val)
						#f)
				      #:expand "YES"
				      #:multiline "YES"
				      #:font "Courier New, -10"
				      #:size "100x150")))
		   (hash-table-set! widgets "Test Data"
				    (lambda (testdat) ;; 
				      (let* ((currval (iup:attribute test-data "VALUE")) ;; "TITLE"))
					     (fmtstr  "~10a~10a~10a~10a~7a~7a~6a~a") ;; category,variable,value,expected,tol,units,comment
					     (newval  (string-intersperse 
						       (append
							(list 
							 (format #f fmtstr "Category" "Variable" "Value" "Expected" "Tol" "Status" "Units" "Comment")
							 (format #f fmtstr "========" "========" "=====" "========" "===" "======" "=====" "======="))
							(map (lambda (x)
							       (format #f fmtstr
								       (db:test-data-get-category x)
								       (db:test-data-get-variable x)
								       (db:test-data-get-value    x)
								       (db:test-data-get-expected x)
								       (db:test-data-get-tol      x)
								       (db:test-data-get-status   x)
								       (db:test-data-get-units    x)
								       (db:test-data-get-comment  x)))
							     (db:read-test-data db test-id "%")))
						       "\n")))
					(if (not (equal? currval newval))
					    (iup:attribute-set! test-data "VALUE" newval ))))) ;; "TITLE" newval)))))
		   test-data)))
		)))
      (iup:show self)
      (iup:callback-set! *tim* "ACTION_CB"
			 (lambda (x)
			   ;; Now start keeping the gui updated from the db
			   (refreshdat) ;; update from the db here
					;(thread-suspend! other-thread)
			   ;; update the gui elements here
︙

Modified db.scm from [6ac1329f07] to [46092bce0d].

︙
557
558
559
560
561
562
563
564

565
566
567
568
569
570
571

557
558
559
560
561
562
563

564
565
566
567
568
569
570
571








-
+








;; get a list of test_data records matching categorypatt
(define (db:read-test-data db test-id categorypatt)
  (let ((res '()))
    (sqlite3:for-each-row 
     (lambda (id test_id category variable value expected tol units comment status)
       (set! res (cons res (vector id test_id category variable value expected tol units comment status))))
     db
     "SELECT id,test_id,category,variable,value,expected,tol,units,comment,status FROM test_data WHERE test_id=? AND category LIKE ?;" test-id categorypatt)
     "SELECT id,test_id,category,variable,value,expected,tol,units,comment,status FROM test_data WHERE test_id=? AND category LIKE ? ORDER BY category,variable;" test-id categorypatt)
    (reverse res)))

(define (db:load-test-data db run-id test-name itemdat)
  (let* ((item-path (item-list->path itemdat))
	 (testdat (db:get-test-info db run-id test-name item-path))
	 (test-id (if testdat (db:test-get-id testdat) #f)))
    ;; (debug:print 1 "Enter records to insert in the test_data table, seven fields, comma separated per line")
︙
687
688
689
690
691
692
693
694
695
696
697




698
699
700
701
702
703
704

705
706
707
708
709
710
711

687
688
689
690
691
692
693




694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712








-
-
-
-
+
+
+
+







+








	      (vector-set! record 4 (let ((startt (any->number (vector-ref record 1)))
					  (endt   (any->number (vector-ref record 2))))
				      (debug:print 4 "record[1]=" (vector-ref record 1) 
						   ", startt=" startt ", endt=" endt
						   ", get-status: " (db:step-get-status step))
				      (if (and (number? startt)(number? endt))
					  (seconds->hr-min-sec (- endt startt)) "-1"))))
	     (else   (vector-set! record 1 (db:step-get-event_time step))))
	   (vector-set! record 2 (db:step-get-state step))
	   (vector-set! record 3 (db:step-get-status step))
	   (vector-set! record 4 (db:step-get-event_time step))
	     (else
	        (vector-set! record 2 (db:step-get-state step))
	        (vector-set! record 3 (db:step-get-status step))
	        (vector-set! record 4 (db:step-get-event_time step))))
	   (hash-table-set! res (db:step-get-stepname step) record)
	   (debug:print 6 "record(after)  = " record 
			"\nid:       " (db:step-get-id step)
			"\nstepname: " (db:step-get-stepname step)
			"\nstate:    " (db:step-get-state step)
			"\nstatus:   " (db:step-get-status step)
			"\ntime:     " (db:step-get-event_time step))))
       ;; (else   (vector-set! record 1 (db:step-get-event_time step)))
       (sort steps (lambda (a b)(< (db:step-get-event_time a)(db:step-get-event_time b)))))
      res)))

;; USE: (lset-difference string=? '("a" "b" "c") '("d" "c" "e" "a"))
;;
;; Return a list of prereqs that were NOT met
;;  Tests (and all items) in waiton list must be "COMPLETED" and "PASS"
︙

Modified runs.scm from [3102091d6b] to [94662cef73].

︙
916
917
918
919
920
921
922
923
924


925
926
927
928
929

916
917
918
919
920
921
922


923
924
925
926
927
928
929








-
-
+
+






	  (conc "INSERT OR REPLACE INTO test_steps (test_id,stepname,state,status,event_time,comment) "
		"SELECT " (db:test-get-id new-testdat) ",stepname,state,status,event_time,comment FROM test_steps WHERE test_id=?;")
	  (db:test-get-id testdat))
	 ;; Now duplicate the test data
	 (debug:print 4 "Copying records in test_data from test_id=" (db:test-get-id testdat) " to " (db:test-get-id new-testdat))
	 (sqlite3:execute 
	  db 
	  (conc "INSERT OR REPLACE INTO test_data (test_id,category,variable,value,expected_value,tol,units,comment) "
		"SELECT " (db:test-get-id new-testdat) ",category,variable,value,expected_value,tol,units,comment FROM test_data WHERE test_id=?;")
	  (conc "INSERT OR REPLACE INTO test_data (test_id,category,variable,value,expected,tol,units,comment) "
		"SELECT " (db:test-get-id new-testdat) ",category,variable,value,expected,tol,units,comment FROM test_data WHERE test_id=?;")
	  (db:test-get-id testdat))
	 ))
     prev-tests)))

This page was generated in about 0.111s by Fossil 2.24 [452f8e1ffc] 2024-03-26 15:36:00