Megatest

Check-in [eb760222b4]
Login
Overview
Comment:Moved loading of format module later to avoid strange crashes in read-only areas
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.60
Files: files | file ages | folders
SHA1: eb760222b41ff42c57e3754f7ec31715b4d26319
User & Date: matt on 2015-03-11 23:31:15
Other Links: branch diff | manifest | tags
Context
2015-03-15
22:44
Merged in json output for -list-runs. Bumped version to 1.6009. check-in: b63a26d1e6 user: matt tags: v1.60
2015-03-12
16:04
Started adding json support for list runs Closed-Leaf check-in: 326c8c2840 user: mrwellan tags: list-runs-json
2015-03-11
23:49
Attempt to add ITEM_CALC and QUEUED statuses. Caused problems Closed-Leaf check-in: f12afe92f6 user: matt tags: item_calc-queued
23:31
Moved loading of format module later to avoid strange crashes in read-only areas check-in: eb760222b4 user: matt tags: v1.60
2015-03-09
05:20
Bumping version check-in: 41f22e34be user: matt tags: v1.60
Changes

Modified megatest.scm from [9904680d7f] to [eecae44588].

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
;; Copyright 2006-2012, Matthew Welland.
;; 
;;  This program is made available under the GNU GPL version 2.0 or
;;  greater. See the accompanying file COPYING for details.
;; 
;;  This program is distributed WITHOUT ANY WARRANTY; without even the
;;  implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;;  PURPOSE.

;; (include "common.scm")
;; (include "megatest-version.scm")

(use sqlite3 srfi-1 posix regex regex-case srfi-69 base64 format readline apropos json http-client directory-utils rpc ;; (srfi 18) extras)
     http-client srfi-18 extras) ;;  zmq extras)

;; Added for csv stuff - will be removed
;;
(use sparse-vectors)

(import (prefix sqlite3 sqlite3:))
(import (prefix base64 base64:))












|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
;; Copyright 2006-2012, Matthew Welland.
;; 
;;  This program is made available under the GNU GPL version 2.0 or
;;  greater. See the accompanying file COPYING for details.
;; 
;;  This program is distributed WITHOUT ANY WARRANTY; without even the
;;  implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;;  PURPOSE.

;; (include "common.scm")
;; (include "megatest-version.scm")

(use sqlite3 srfi-1 posix regex regex-case srfi-69 base64 readline apropos json http-client directory-utils rpc ;; (srfi 18) extras)
     http-client srfi-18 extras format) ;;  zmq extras)

;; Added for csv stuff - will be removed
;;
(use sparse-vectors)

(import (prefix sqlite3 sqlite3:))
(import (prefix base64 base64:))
910
911
912
913
914
915
916



917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
		   (let* ((run-id (db:get-value-by-header run header "id"))
			  (tests  (db:get-tests-for-run dbstruct run-id testpatt '() '() #f #f #f 'testname 'asc #f)))
		     (print "Run: " targetstr "/" (db:get-value-by-header run header "runname") 
			    " status: " (db:get-value-by-header run header "state")
			    " run-id: " run-id ", number tests: " (length tests))
		     (for-each 
		      (lambda (test)



			(format #t
				"  Test: ~25a State: ~15a Status: ~15a Runtime: ~5@as Time: ~22a Host: ~10a\n"
				(conc (db:test-get-testname test)
				      (if (equal? (db:test-get-item-path test) "")
					  "" 
					  (conc "(" (db:test-get-item-path test) ")")))
				(db:test-get-state test)
				(db:test-get-status test)
				(db:test-get-run_duration test)
				(db:test-get-event_time test)
				(db:test-get-host test))
			(if (not (or (equal? (db:test-get-status test) "PASS")
			   	     (equal? (db:test-get-status test) "WARN")
				     (equal? (db:test-get-state test)  "NOT_STARTED")))
			    (begin
			      (print   "         cpuload:  " (db:test-get-cpuload test)
				     "\n         diskfree: " (db:test-get-diskfree test)
				     "\n         uname:    " ;; (sdb:qry 'getstr 







>
>
>
|
|
|
|
|
|
|
|
|
|
|







910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
		   (let* ((run-id (db:get-value-by-header run header "id"))
			  (tests  (db:get-tests-for-run dbstruct run-id testpatt '() '() #f #f #f 'testname 'asc #f)))
		     (print "Run: " targetstr "/" (db:get-value-by-header run header "runname") 
			    " status: " (db:get-value-by-header run header "state")
			    " run-id: " run-id ", number tests: " (length tests))
		     (for-each 
		      (lambda (test)
			(handle-exceptions
			 exn
			 (debug:print 0 "ERROR: Bad data in test record? " test)
			 (format #t
				 "  Test: ~25a State: ~15a Status: ~15a Runtime: ~5@as Time: ~22a Host: ~10a\n"
				 (conc (db:test-get-testname test)
				       (if (equal? (db:test-get-item-path test) "")
					   "" 
					   (conc "(" (db:test-get-item-path test) ")")))
				 (db:test-get-state test)
				 (db:test-get-status test)
				 (db:test-get-run_duration test)
				 (db:test-get-event_time test)
				 (db:test-get-host test)))
			(if (not (or (equal? (db:test-get-status test) "PASS")
			   	     (equal? (db:test-get-status test) "WARN")
				     (equal? (db:test-get-state test)  "NOT_STARTED")))
			    (begin
			      (print   "         cpuload:  " (db:test-get-cpuload test)
				     "\n         diskfree: " (db:test-get-diskfree test)
				     "\n         uname:    " ;; (sdb:qry 'getstr