Megatest

Check-in [ea880f01b9]
Login
Overview
Comment:Partial implementation of test steps as text box
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: ea880f01b97697a3bc398dfdc1b935febdb67941
User & Date: matt on 2011-09-12 06:51:50
Other Links: manifest | tags
Context
2011-09-12
07:04
Merged in rollup branch check-in: 7a69e38634 user: matt tags: trunk
06:51
Partial implementation of test steps as text box check-in: ea880f01b9 user: matt tags: trunk
00:05
Rollup to test_data completed. Rebuild db reworked check-in: d406fee8c4 user: matt tags: trunk, v1.24
Changes

Modified dashboard-tests.scm from [563dea2bd2] to [f142c4ac47].

346
347
348
349
350
351
352
353
354
355
356









357
358

359
360
361
362
363
364
365
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







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

-
+







			  (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:frame 
		#:title "Test Steps"
		(let ((stepsdat (iup:label "Test steps ........................................." 
					   #:expand "YES" 
					   #:size "200x150"
					   #:alignment "ALEFT:ATOP")))
		(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 "TITLE"))
							  (let* ((currval (iup:attribute stepsdat "VALUE")) ;; "TITLE"))
								 (fmtstr  "~25a~10a~10a~15a~20a")
								 (comprsteps (db:get-steps-table db test-id))
								 (newval  (string-intersperse 
									   (append
									    (list 
									     (format #f fmtstr "Stepname" "Start" "End"    "Status" "Time")
									     (format #f fmtstr "========" "=====" "======" "======" "=========="))
376
377
378
379
380
381
382
383

384
385
386
387
388
389
390
381
382
383
384
385
386
387

388
389
390
391
392
393
394
395







-
+







										 (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 "TITLE" newval)))))
								(iup:attribute-set! stepsdat "VALUE" newval ))))) ;; "TITLE" newval)))))
		  stepsdat)))))
      (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)

Modified db.scm from [dacaca63c6] to [d2c04b8411].

645
646
647
648
649
650
651








652
653
654
655
656
657
658
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666







+
+
+
+
+
+
+
+







     (lambda (id test-id stepname state status event-time)
       (set! res (cons (vector id test-id stepname state status event-time) res)))
     db
     "SELECT id,test_id,stepname,state,status,event_time FROM test_steps WHERE test_id=? ORDER BY id ASC;" ;; event_time DESC,id ASC;
     test-id)
    (reverse res)))

;; 
(define (make-db:steps-table)(make-vector 5))
(define-inline (db:steps-table-get-stepname   vec)    (vector-ref  vec 0))
(define-inline (db:steps-table-get-start      vec)    (vector-ref  vec 1))
(define-inline (db:steps-table-get-end        vec)    (vector-ref  vec 2))
(define-inline (db:steps-table-get-status     vec)    (vector-ref  vec 3))
(define-inline (db:steps-table-get-runtime    vec)    (vector-ref  vec 4))

;; get a pretty table to summarize steps
;;
(define (db:get-steps-table db test-id)
  (let ((steps   (db:get-steps-for-test db test-id)))
    ;; organise the steps for better readability
    (let ((res (make-hash-table)))
      (for-each 

Modified server.scm from [f6c984417d] to [9b405ea575].

43
44
45
46
47
48
49
50

51
52
53
54
55
56
57
58
43
44
45
46
47
48
49

50















-
+
-
-
-
-
-
-
-
-
   (tcp-listen (rpc:default-server-port))))

(define (server:client-setup db)
  (let* ((hostinfo (db:get-var db "SERVER"))
	 (hostdat  (if hostinfo (string-split hostinfo ":")))
	 (host     (if hostinfo (car hostdat)))
	 (port     (if (and hostinfo (> (length hostdat) 1))(cadr hostdat) #f)))
    
    (set! *runremote* (vector host port))))
    (rpc:publish-procedure!
     'query
     host
     (lambda (sql callback)
       (print "Executing query '" sql "' ...")
       (sqlite3:for-each-row
	callback
	db sql))))