Megatest

Diff
Login

Differences From Artifact [28774d006a]:

To Artifact [d9a37585c9]:


235
236
237
238
239
240
241



242
243
244
245
246
247
248
			"-rebuild-db"
			"-cleanup-db"
			"-rollup"
			"-update-meta"
			"-gen-megatest-area"
			"-mark-incompletes"




			"-logging"
			"-v" ;; verbose 2, more than normal (normal is 1)
			"-q" ;; quiet 0, errors/warnings only
		       )
		 args:arg-hash
		 0))








>
>
>







235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
			"-rebuild-db"
			"-cleanup-db"
			"-rollup"
			"-update-meta"
			"-gen-megatest-area"
			"-mark-incompletes"

			"-convert-to-norm"
			"-convert-to-old"

			"-logging"
			"-v" ;; verbose 2, more than normal (normal is 1)
			"-q" ;; quiet 0, errors/warnings only
		       )
		 args:arg-hash
		 0))

289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
;;  (hash-table-set! args:arg-hash "-transport" "fs"))

;;======================================================================
;; Misc setup stuff
;;======================================================================

(debug:setup)
(sdb:qry 'init #f)

(if (args:get-arg "-logging")(set! *logging* #t))

(if (debug:debug-mode 3) ;; we are obviously debugging
    (set! open-run-close open-run-close-no-exception-handling))

(if (args:get-arg "-itempatt")







<







292
293
294
295
296
297
298

299
300
301
302
303
304
305
;;  (hash-table-set! args:arg-hash "-transport" "fs"))

;;======================================================================
;; Misc setup stuff
;;======================================================================

(debug:setup)


(if (args:get-arg "-logging")(set! *logging* #t))

(if (debug:debug-mode 3) ;; we are obviously debugging
    (set! open-run-close open-run-close-no-exception-handling))

(if (args:get-arg "-itempatt")
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970

	  (if (args:get-arg "-load-test-data")
	      ;; has sub commands that are rdb:
	      ;; DO NOT put this one into either cdb:remote-run or open-run-close
	      (db:load-test-data db test-id work-area: work-area))
	  (if (args:get-arg "-setlog")
	      (let ((logfname (args:get-arg "-setlog")))
		(cdb:test-set-log! *runremote* test-id logfname)))
	  (if (args:get-arg "-set-toplog")
	      ;; DO NOT run remote
	      (tests:test-set-toplog! db run-id test-name (args:get-arg "-set-toplog")))
	  (if (args:get-arg "-summarize-items")
	      ;; DO NOT run remote
	      (tests:summarize-items db run-id test-id test-name #t)) ;; do force here
	  (if (args:get-arg "-runstep")







|







958
959
960
961
962
963
964
965
966
967
968
969
970
971
972

	  (if (args:get-arg "-load-test-data")
	      ;; has sub commands that are rdb:
	      ;; DO NOT put this one into either cdb:remote-run or open-run-close
	      (db:load-test-data db test-id work-area: work-area))
	  (if (args:get-arg "-setlog")
	      (let ((logfname (args:get-arg "-setlog")))
		(cdb:test-set-log! *runremote* test-id (sdb:qry 'getid logfname))))
	  (if (args:get-arg "-set-toplog")
	      ;; DO NOT run remote
	      (tests:test-set-toplog! db run-id test-name (args:get-arg "-set-toplog")))
	  (if (args:get-arg "-summarize-items")
	      ;; DO NOT run remote
	      (tests:summarize-items db run-id test-id test-name #t)) ;; do force here
	  (if (args:get-arg "-runstep")
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
			       (oldexitstat exitstat)
			       (cmd         (string-intersperse (list "logpro" logprofile htmllogfile "<" logfile ">" (conc stepname "_logpro.log")) " ")))
			  (debug:print-info 2 "running \"" cmd "\"")
			  (change-directory startingdir)
			  (set! exitstat (system cmd))
			  (set! *globalexitstatus* exitstat) ;; no necessary
			  (change-directory testpath)
			  (cdb:test-set-log! *runremote* test-id htmllogfile)))
		    (let ((msg (args:get-arg "-m")))
		      ;; DO NOT run remote
		      (db:teststep-set-status! db test-id stepname "end" exitstat msg logfile work-area: work-area))
		    )))
	  (if (or (args:get-arg "-test-status")
		  (args:get-arg "-set-values"))
	      (let ((newstatus (cond







|







1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
			       (oldexitstat exitstat)
			       (cmd         (string-intersperse (list "logpro" logprofile htmllogfile "<" logfile ">" (conc stepname "_logpro.log")) " ")))
			  (debug:print-info 2 "running \"" cmd "\"")
			  (change-directory startingdir)
			  (set! exitstat (system cmd))
			  (set! *globalexitstatus* exitstat) ;; no necessary
			  (change-directory testpath)
			  (cdb:test-set-log! *runremote* test-id (sdb:qry 'getid htmllogfile))))
		    (let ((msg (args:get-arg "-m")))
		      ;; DO NOT run remote
		      (db:teststep-set-status! db test-id stepname "end" exitstat msg logfile work-area: work-area))
		    )))
	  (if (or (args:get-arg "-test-status")
		  (args:get-arg "-set-values"))
	      (let ((newstatus (cond
1153
1154
1155
1156
1157
1158
1159

























1160
1161
1162
1163
1164
1165
1166
	      (or (get-environment-variable "HOME") ".") "/.megatest_history"))
	    (current-input-port (make-gnu-readline-port "megatest> "))
	    (if (args:get-arg "-repl")
		(repl)
		(load (args:get-arg "-load"))))
	  (exit))
      (set! *didsomething* #t)))


























;;======================================================================
;; Exit and clean up
;;======================================================================

(if *runremote* (close-all-connections!))








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







1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
	      (or (get-environment-variable "HOME") ".") "/.megatest_history"))
	    (current-input-port (make-gnu-readline-port "megatest> "))
	    (if (args:get-arg "-repl")
		(repl)
		(load (args:get-arg "-load"))))
	  (exit))
      (set! *didsomething* #t)))

(if (args:get-arg "-convert-to-norm")
    (let* ((toppath (setup-for-run))
	   (db      (if toppath (open-db) #f)))
      (for-each 
       (lambda (field)
	 (let ((dat '()))
	   (debug:print-info 0 "Getting data for field " field)
	   (sqlite3:for-each-row
	    (lambda (id val)
	      (set! dat (cons (list id val) dat)))
	    db
	    (conc "SELECT id," field " FROM tests;"))
	   (debug:print-info 0 "found " (length dat) " items for field " field)
	   (let ((qry (sqlite3:prepare db (conc "UPDATE tests SET " field "=? WHERE id=?;"))))
	     (for-each
	      (lambda (item)
		(let ((newval (sdb:qry 'getid (cadr item))))
		  (if (not (equal? newval (cadr item)))
		      (debug:print-info 0 "Converting " (cadr item) " to " newval " for test #" (car item)))
		  (sqlite3:execute qry newval (car item))))
	      dat)
	     (sqlite3:finalize! qry))))
       (list "uname" "rundir" "final_logf" "comment"))
      (set! *didsomething* #t)))

;;======================================================================
;; Exit and clean up
;;======================================================================

(if *runremote* (close-all-connections!))