Megatest

Check-in [b63a26d1e6]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Merged in json output for -list-runs. Bumped version to 1.6009.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.60
Files: files | file ages | folders
SHA1: b63a26d1e6f7436bb6981c5ec9d52adf8fcb46a5
User & Date: matt on 2015-03-15 22:44:48
Other Links: branch diff | manifest | tags
Context
2015-03-15
23:52
Added mutils to make install of chicken. Use bashisms in mt_ezstep check-in: aaef4b35a4 user: matt tags: v1.60
22:44
Merged in json output for -list-runs. Bumped version to 1.6009. check-in: b63a26d1e6 user: matt tags: v1.60
2015-03-11
23:31
Moved loading of format module later to avoid strange crashes in read-only areas check-in: eb760222b4 user: matt tags: v1.60
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Modified megatest-version.scm from [3234777933] to [66e3f5fa5c]. 

1
2
3
4
5
6
7

;; Always use two or four digit decimal
;; 1.01, 1.02...1.10,1.11,1,1101 ... 1.99,2.00..

(declare (unit megatest-version))

(define megatest-version 1.6008)







|


1
2
3
4
5
6
7

;; Always use two or four digit decimal
;; 1.01, 1.02...1.10,1.11,1,1101 ... 1.99,2.00..

(declare (unit megatest-version))

(define megatest-version 1.6009)

Modified megatest.scm from [eecae44588] to [3602970f94].

︙︙
16
17
18
19
20
21
22

23
24
25
26
27
28
29

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

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


;; (use zmq)

(declare (uses common))
(declare (uses megatest-version))
(declare (uses margs))
(declare (uses runs))








>








16
17
18
19
20
21
22
23
24
25
26
27
28
29
30

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

(import (prefix sqlite3 sqlite3:))
(import (prefix base64 base64:))
(import (prefix rpc rpc:))
(require-library mutils)

;; (use zmq)

(declare (uses common))
(declare (uses megatest-version))
(declare (uses margs))
(declare (uses runs))
︙︙
889
890
891
892
893
894
895
896



897
898
899
900
901
902
903
904
905
906
907
908
909
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
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963

	       ;; (runsdat  (db:get-runs dbstruct runpatt #f #f '()))
	       (runsdat  (db:get-runs-by-patt dbstruct keys (or runpatt "%") (common:args-get-target)
					 #f #f))
		;; (cdb:remote-run db:get-runs #f runpatt #f #f '()))
	       (runs     (db:get-rows runsdat))
	       (header   (db:get-header runsdat))
	       (db-targets (args:get-arg "-list-db-targets"))
	       (seen     (make-hash-table)))



	  ;; Each run
	  (for-each 
	   (lambda (run)
	     (let ((targetstr (string-intersperse (map (lambda (x)
							 (db:get-value-by-header run header x))
						       keys) "/")))
	       (if db-targets
		   (if (not (hash-table-ref/default seen targetstr #f))
		       (begin
			 (hash-table-set! seen targetstr #t)
			 ;; (print "[" targetstr "]"))))
			 (print targetstr))))
	       (if (not db-targets)
		   (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 
				     (db:test-get-uname test) ;; )
				     "\n         rundir:   " ;; (sdb:qry 'getstr ;; (filedb:get-path *fdb* 
				     (db:test-get-rundir test) ;; )
				     )
			      ;; Each test
			      ;; DO NOT remote run
			      (let ((steps (db:get-steps-for-test dbstruct run-id (db:test-get-id test))))
				(for-each 
				 (lambda (step)
				   (format #t 
					   "    Step: ~20a State: ~10a Status: ~10a Time ~22a\n"
					   (tdb:step-get-stepname step)
					   (tdb:step-get-state step)
					   (tdb:step-get-status step)
					   (tdb:step-get-event_time step)))
				 steps)))))
		      tests)))))
	     runs)
	  ;; (db:close-all dbstruct)
	  (set! *didsomething* #t))))

;;======================================================================
;; full run
;;======================================================================

;; get lock in db for full run for this directory








|
>
>
>











|
|
|

>
>
>
>
>
>
|
|
|


|


|
<
|
|
|
|
|
|
>
>
>
>
>
>
>
>
>
>
>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|

|
|








890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
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
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983

	       ;; (runsdat  (db:get-runs dbstruct runpatt #f #f '()))
	       (runsdat  (db:get-runs-by-patt dbstruct keys (or runpatt "%") (common:args-get-target)
					 #f #f))
		;; (cdb:remote-run db:get-runs #f runpatt #f #f '()))
	       (runs     (db:get-rows runsdat))
	       (header   (db:get-header runsdat))
	       (db-targets (args:get-arg "-list-db-targets"))
	       (seen     (make-hash-table))
	       (dmode    (let ((d (args:get-arg "-dumpmode")))
			   (if d (string->symbol d) #f)))
	       (data     (make-hash-table)))
	  ;; Each run
	  (for-each 
	   (lambda (run)
	     (let ((targetstr (string-intersperse (map (lambda (x)
							 (db:get-value-by-header run header x))
						       keys) "/")))
	       (if db-targets
		   (if (not (hash-table-ref/default seen targetstr #f))
		       (begin
			 (hash-table-set! seen targetstr #t)
			 ;; (print "[" targetstr "]"))))
			 (if (not dmode)(print targetstr))))
		   (let* ((run-id  (db:get-value-by-header run header "id"))
			  (runname (db:get-value-by-header run header "runname")) 
			  (tests  (db:get-tests-for-run dbstruct run-id testpatt '() '() #f #f #f 'testname 'asc #f)))
		     (case dmode
		       ((json)
			(mutils:hierhash-set! data targetstr runname "meta" "status" (db:get-value-by-header run header "status"))
			(mutils:hierhash-set! data targetstr runname "meta" "state"  (db:get-value-by-header run header "state"))
			(mutils:hierhash-set! data targetstr runname "meta" "id"     (conc (db:get-value-by-header run header "id"))))
		       (else
			(print "Run: " targetstr "/" 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)
			 (let ((test-id  (db:test-get-id test))

			       (fullname (conc (db:test-get-testname test)
					       (if (equal? (db:test-get-item-path test) "")
						   "" 
						   (conc "(" (db:test-get-item-path test) ")"))))
			       (tstate   (db:test-get-state test))
			       (tstatus  (db:test-get-status test)))
			   (case dmode
			     ((json)
			      (mutils:hierhash-set! data targetstr runname "data" (conc test-id) "tname" fullname)
			      (mutils:hierhash-set! data targetstr runname "data" (conc test-id) "state" tstate)
			      (mutils:hierhash-set! data targetstr runname "data" (conc test-id) "status" tstatus))
			     (else
			      (format #t
				      "  Test: ~25a State: ~15a Status: ~15a Runtime: ~5@as Time: ~22a Host: ~10a\n"
				      fullname
				      tstate
				      tstatus
				      (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:    " (db:test-get-uname test)
					     "\n         rundir:   " (db:test-get-rundir test)
					     "\n         rundir:   " ;; (sdb:qry 'getstr ;; (filedb:get-path *fdb* 
					     (db:test-get-rundir test) ;; )
					     )
				    ;; Each test
				    ;; DO NOT remote run
				    (let ((steps (db:get-steps-for-test dbstruct run-id (db:test-get-id test))))
				      (for-each 
				       (lambda (step)
					 (format #t 
						 "    Step: ~20a State: ~10a Status: ~10a Time ~22a\n"
						 (tdb:step-get-stepname step)
						 (tdb:step-get-state step)
						 (tdb:step-get-status step)
						 (tdb:step-get-event_time step)))
				       steps)))))))))
		      tests)))))
	   runs)
	  (if (eq? dmode 'json)(json-write data))
	  (set! *didsomething* #t))))

;;======================================================================
;; full run
;;======================================================================

;; get lock in db for full run for this directory
︙︙

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