Megatest

Check-in [b2b8a3f26c]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Got cells.scm and matrix.scm example files working. More steps stuff working Added tests for ezsteps and logpro l
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: b2b8a3f26c1c44ddb1ba7b9646eae590239b58d4
User & Date: matt on 2011-11-05 18:11:11
Other Links: manifest | tags
Context
2011-11-06
14:42
Added tree widget example check-in: 24cc661bd8 user: matt tags: trunk
2011-11-05
18:11
Got cells.scm and matrix.scm example files working. More steps stuff working Added tests for ezsteps and logpro l check-in: b2b8a3f26c user: matt tags: trunk
2011-11-04
23:25
Added cells example code check-in: f319171913 user: mrwellan tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Modified cells.scm from [92e5ab296a] to [81e160db9e]. 

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45

;; (require-library iup canvas-draw)
;; 
;; (module cells-test
;; 	(cells-dialog)
;; 	(import
;; 	 scheme chicken extras
;; 	 iup canvas-draw
;; 	 (only canvas-draw-base pointer->canvas))
;; 

(use iup canvas-draw canvas-draw-base)
(define ncols  8)
(define nlins  8)
(define width  32)
(define height  32)

(define (render-cell handle i j x-min x-max y-min y-max canvas)
  (set! (canvas-foreground canvas)
	(if (or (and (odd? i) (odd? j)) (and (even? i) (even? j)))
	    #xffffff
	    #x000000))
  (canvas-box! canvas x-min x-max y-min y-max))

(define cells-dialog
  (dialog
   #:title "Cells Test"
   (cells
    #:rastersize (format "~sx~s" (* ncols width) (* nlins height))
    #:ncols-cb (lambda _ ncols) #:width-cb (lambda _ width)
    #:nlines-cb (lambda _ nlins) #:height-cb (lambda _ height)
    #:draw-cb
    ;; (make-cells-draw-cb render-cell))))

    (let ([wrap (pointer->canvas #t)])
      (lambda (handle i j x-min x-max y-min y-max canvas)
	(render-cell handle i j x-min x-max y-min y-max (wrap canvas)))))))

;; )

;; (import
;;  (only iup show main-loop)
;;  cells-test)

(show cells-dialog)
(main-loop)

|
|
|
|
|
|
|
|
<
|
<




















|
|
<
<
<

<
<
|
|
|




1
2
3
4
5
6
7
8

9

10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31



32


33
34
35
36
37
38

(require-library iup canvas-draw canvas-draw-iup)

(module cells-test
 	(cells-dialog)
 	(import
 	 scheme chicken extras
 	 iup canvas-draw canvas-draw-iup
 	 (only canvas-draw-base pointer->canvas))

 

(define ncols  8)
(define nlins  8)
(define width  32)
(define height  32)

(define (render-cell handle i j x-min x-max y-min y-max canvas)
  (set! (canvas-foreground canvas)
	(if (or (and (odd? i) (odd? j)) (and (even? i) (even? j)))
	    #xffffff
	    #x000000))
  (canvas-box! canvas x-min x-max y-min y-max))

(define cells-dialog
  (dialog
   #:title "Cells Test"
   (cells
    #:rastersize (format "~sx~s" (* ncols width) (* nlins height))
    #:ncols-cb (lambda _ ncols) #:width-cb (lambda _ width)
    #:nlines-cb (lambda _ nlins) #:height-cb (lambda _ height)
    #:draw-cb
    (make-cells-draw-cb render-cell))))
)






(import
 (only iup show main-loop)
  cells-test)

(show cells-dialog)
(main-loop)

Modified dashboard-tests.scm from [f1756cabc9] to [e8ada23103].

︙︙
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

				     #:expand "YES"
				     #:multiline "YES"
				     #:font "Courier New, -10"
				     #:size "60x100")))
		   (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)
								     (let ((time-a (vector-ref a 1))
									   (time-b (vector-ref b 1)))
								     (if (and (number? time-a)(number? time-b))
									 (< time-a time-b)
									 #t))))))








|




|
|









|
>








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

				     #:expand "YES"
				     #:multiline "YES"
				     #:font "Courier New, -10"
				     #:size "60x100")))
		   (hash-table-set! widgets "Test Steps" 
				    (lambda (testdat)
				      (let* ((currval (iup:attribute stepsdat "VALUE")) ;; "TITLE"))
					     (fmtstr  "~20a~10a~10a~12a~15a~20a")
					     (comprsteps (db:get-steps-table db test-id))
					     (newval  (string-intersperse 
						       (append
							(list 
							 (format #f fmtstr "Stepname" "Start" "End" "Status" "Time" "Logfile")
							 (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)
								       (vector-ref x 5)))  ;; time delta
							     (sort (hash-table-values comprsteps)
								   (lambda (a b)
								     (let ((time-a (vector-ref a 1))
									   (time-b (vector-ref b 1)))
								     (if (and (number? time-a)(number? time-b))
									 (< time-a time-b)
									 #t))))))
︙︙

Modified db.scm from [fa70f2b097] to [a0f5c8d96a].

︙︙
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647



648
649
650
651
652
653
654
655
656
657



658
659
660
661
662
663
664

(define (db:step-get-time-as-string vec)
    (seconds->time-string (db:step-get-event_time vec)))

;; db-get-test-steps-for-run
(define (db:get-steps-for-test db test-id)
  (let ((res '()))
    (sqlite3:for-each-row 
     (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)))

;; 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 
       (lambda (step)
	 (debug:print 6 "step=" step)
	 (let ((record (hash-table-ref/default 
			res 
			(db:step-get-stepname step) 
			;;        stepname                start end status    
			(vector (db:step-get-stepname step) ""   "" ""     ""))))
	   (debug:print 6 "record(before) = " 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))
	   (case (string->symbol (db:step-get-state step))
	     ((start)(vector-set! record 1 (db:step-get-event_time step))
	      (vector-set! record 3 (if (equal? (vector-ref record 3) "")
					(db:step-get-status step))))



	     ((end)  
	      (vector-set! record 2 (any->number (db:step-get-event_time step)))
	      (vector-set! record 3 (db:step-get-status step))
	      (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 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)








|
|

|
















|









|
>
>
>









|
>
>
>








610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670

(define (db:step-get-time-as-string vec)
    (seconds->time-string (db:step-get-event_time vec)))

;; db-get-test-steps-for-run
(define (db:get-steps-for-test db test-id)
  (let ((res '()))
    (sqlite3:for-each-row 
     (lambda (id test-id stepname state status event-time logfile)
       (set! res (cons (vector id test-id stepname state status event-time logfile) res)))
     db
     "SELECT id,test_id,stepname,state,status,event_time,logfile FROM test_steps WHERE test_id=? ORDER BY id ASC;" ;; event_time DESC,id ASC;
     test-id)
    (reverse res)))

;; 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 
       (lambda (step)
	 (debug:print 6 "step=" step)
	 (let ((record (hash-table-ref/default 
			res 
			(db:step-get-stepname step) 
			;;        stepname                start end status    
			(vector (db:step-get-stepname step) ""   "" ""     "" ""))))
	   (debug:print 6 "record(before) = " 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))
	   (case (string->symbol (db:step-get-state step))
	     ((start)(vector-set! record 1 (db:step-get-event_time step))
	      (vector-set! record 3 (if (equal? (vector-ref record 3) "")
					(db:step-get-status step)))
	      (if (> (string-length (db:step-get-logfile step))
		     0)
		  (vector-set! record 5 (db:step-get-logfile step))))
	     ((end)  
	      (vector-set! record 2 (any->number (db:step-get-event_time step)))
	      (vector-set! record 3 (db:step-get-status step))
	      (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")))
	      (if (> (string-length (db:step-get-logfile step))
		     0)
		  (vector-set! record 5 (db:step-get-logfile 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)
︙︙

Modified db_records.scm from [5b29510193] to [e1374dd7ef].

︙︙
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
94
95

(define-inline (db:test-data-get-status           vec)    (vector-ref  vec 9))

;;======================================================================
;; S T E P S 
;;======================================================================
;; Run steps
;; make-vector-record "Run steps" db step id test_id stepname step_complete step_pass event_time    
(define (make-db:step)(make-vector 6))
(define-inline (db:step-get-id              vec)    (vector-ref  vec 0))
(define-inline (db:step-get-test_id         vec)    (vector-ref  vec 1))
(define-inline (db:step-get-stepname        vec)    (vector-ref  vec 2))
(define-inline (db:step-get-state           vec)    (vector-ref  vec 3))
(define-inline (db:step-get-status          vec)    (vector-ref  vec 4))
(define-inline (db:step-get-event_time      vec)    (vector-ref  vec 5))

(define-inline (db:step-set-id!             vec val)(vector-set! vec 0 val))
(define-inline (db:step-set-test_id!        vec val)(vector-set! vec 1 val))
(define-inline (db:step-set-stepname!       vec val)(vector-set! vec 2 val))
(define-inline (db:step-set-state!          vec val)(vector-set! vec 3 val))
(define-inline (db:step-set-status!         vec val)(vector-set! vec 4 val))
(define-inline (db:step-set-event_time!     vec val)(vector-set! vec 5 val))



;; The steps table
(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))








|






>






>
>








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
94
95
96
97
98

(define-inline (db:test-data-get-status           vec)    (vector-ref  vec 9))

;;======================================================================
;; S T E P S 
;;======================================================================
;; Run steps
;; make-vector-record "Run steps" db step id test_id stepname step_complete step_pass event_time    
(define (make-db:step)(make-vector 7))
(define-inline (db:step-get-id              vec)    (vector-ref  vec 0))
(define-inline (db:step-get-test_id         vec)    (vector-ref  vec 1))
(define-inline (db:step-get-stepname        vec)    (vector-ref  vec 2))
(define-inline (db:step-get-state           vec)    (vector-ref  vec 3))
(define-inline (db:step-get-status          vec)    (vector-ref  vec 4))
(define-inline (db:step-get-event_time      vec)    (vector-ref  vec 5))
(define-inline (db:step-get-logfile         vec)    (vector-ref  vec 6))
(define-inline (db:step-set-id!             vec val)(vector-set! vec 0 val))
(define-inline (db:step-set-test_id!        vec val)(vector-set! vec 1 val))
(define-inline (db:step-set-stepname!       vec val)(vector-set! vec 2 val))
(define-inline (db:step-set-state!          vec val)(vector-set! vec 3 val))
(define-inline (db:step-set-status!         vec val)(vector-set! vec 4 val))
(define-inline (db:step-set-event_time!     vec val)(vector-set! vec 5 val))
(define-inline (db:step-set-logfile!        vec val)(vector-set! vec 6 val))


;; The steps table
(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))
︙︙

Added matrix.scm version [80b32addb5]. 



























































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44

(require-library iup canvas-draw canvas-draw-iup)

(module matrix-test
 	(matrix-dialog)
 	(import
 	 scheme chicken extras
 	 iup canvas-draw canvas-draw-iup
 	 (only canvas-draw-base pointer->canvas))
 
(define ncols  8)
(define nlins  8)
(define width  32)
(define height  32)

;; (define (render-cell handle i j x-min x-max y-min y-max canvas)
;;   (set! (canvas-foreground canvas)
;; 	(if (or (and (odd? i) (odd? j)) (and (even? i) (even? j)))
;; 	    #xffffff
;; 	    #x000000))
;;   (canvas-box! canvas x-min x-max y-min y-max))

(define matrix-dialog
  (dialog
   #:title "Matrix Test"
   (let ((mat (matrix
	       ; #:expand "YES"
	       ; #:scrollbar "YES"
	       #:numcol ncols 
	       #:numlin nlins 
	       #:numcol-visible ncols 
	       #:numlin-visible nlins
	       #:click-cb (lambda (obj lin col status)
			    (print "obj: " obj " lin: " lin " col: " col " status: " status)))))
     (attribute-set! mat "0:0" "Testing")
     mat)))

) ;; end module

(import
 (only iup show main-loop)
  matrix-test)

(show matrix-dialog)
(main-loop)

Modified tests/tests/ezlog_fail/lookittmp.logpro from [1d9c0ef873] to [ea65513f61]. 

1
2
3
4
5
6
7
8
9
10

;; (c) 2006,2007,2008,2009 Matthew Welland matt@kiatoa.com
;;  
;;   License GPL.


(expect:required in "LogFileBody" > 0 "Must be some files in the dir" #/.*/)

(expect:ignore   in "LogFileBody"  < 99 "Ignore the word error in comments" #/^\/\/.*error/)
(expect:warning  in "LogFileBody"  = 0 "Any warning" #/WARNING/)
(expect:error    in "LogFileBody"  = 0 "Any error"  (list #/ERROR/ #/error/)) ;; but disallow any other errors






|





1
2
3
4
5
6
7
8
9
10

;; (c) 2006,2007,2008,2009 Matthew Welland matt@kiatoa.com
;;  
;;   License GPL.


(expect:required in "LogFileBody" > 0 "Must be some files in the dir" #/this hopefully will never match anything eh?/)

(expect:ignore   in "LogFileBody"  < 99 "Ignore the word error in comments" #/^\/\/.*error/)
(expect:warning  in "LogFileBody"  = 0 "Any warning" #/WARNING/)
(expect:error    in "LogFileBody"  = 0 "Any error"  (list #/ERROR/ #/error/)) ;; but disallow any other errors

Modified tests/tests/ezlog_fail/testconfig from [13eb33bb90] to [39388ec16f]. 

1
2
3
4
5
6
7
8
9
10
11
12
13

[setup]

[ezsteps]
lookittmp   ls /tmp
lookithome  ls /home

[test_meta]
author matt
owner  bob
description This test runs a single ezstep which is expected to pass using a simple logpro file.

tags first,single
reviewed 09/10/2011, by Matt










|




1
2
3
4
5
6
7
8
9
10
11
12
13

[setup]

[ezsteps]
lookittmp   ls /tmp
lookithome  ls /home

[test_meta]
author matt
owner  bob
description This test runs two ezstep, the first of which is expected to fail using a simple logpro file.

tags first,single
reviewed 09/10/2011, by Matt

Modified utils/installall.sh from [7a7c1d6a7f] to [de06fe7884].

︙︙
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52

if [[ $KTYPE == "" ]]; then
  echo 'Using KTYPE=26'
  export KTYPE=26
else
  echo Using KTYPE=$KTYPE
fi

export CHICKEN_VERSION=4.7.0
if ! [[ -e chicken-${CHICKEN_VERSION}.tar.gz ]]; then 
    wget http://code.call-cc.org/dev-snapshots/2011/05/27/chicken-${CHICKEN_VERSION}.tar.gz
fi 

BUILDHOME=$PWD
if [[ $PREFIX == "" ]]; then
   PREFIX=$PWD/inst
fi









|

|








36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52

if [[ $KTYPE == "" ]]; then
  echo 'Using KTYPE=26'
  export KTYPE=26
else
  echo Using KTYPE=$KTYPE
fi

export CHICKEN_VERSION=4.7.3
if ! [[ -e chicken-${CHICKEN_VERSION}.tar.gz ]]; then 
    wget http://code.call-cc.org/dev-snapshots/2011/08/17/chicken-${CHICKEN_VERSION}.tar.gz
fi 

BUILDHOME=$PWD
if [[ $PREFIX == "" ]]; then
   PREFIX=$PWD/inst
fi
︙︙

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