Megatest

Diff
Login

Differences From Artifact [6fa480ef4e]:

To Artifact [8dad4b95f7]:


356
357
358
359
360
361
362
363

364
365
366
367
368
369
370
356
357
358
359
360
361
362

363
364
365
366
367
368
369
370







-
+







		     (hash-table-keys args:arg-hash)
		     '("-list-servers"
		       "-stop-server"
		       "-show-cmdinfo"
		       "-list-runs")))
	(if (setup-for-run)
	    (begin

	      (set! *fdb*   (filedb:open-db (conc *toppath* "/db/paths.db")))
	      ;; if not list or kill then start a client (if appropriate)
	      (if (or (args-defined? "-h" "-version" "-gen-megatest-area" "-gen-megatest-test")
		      (eq? (length (hash-table-keys args:arg-hash)) 0))
		  (debug:print-info 1 "Server connection not needed")
		  ;; ok, so lets connect to the server
		  (let* ((transport-from-config   (configf:lookup *configdat* "setup" "transport"))
			 (transport-from-cmdln    (args:get-arg "-transport"))
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
382
383
384
385
386
387
388


389
390
391
392
393
394
395







-
-







								      "fs"))))
		    (debug:print 2 "chosen-transport: " chosen-transport " have; config=" transport-from-config ", cmdln=" transport-from-cmdln ", cmdinfo=" transport-from-cmdinfo)
		    (case chosen-transport
		      ((http)
		       (set! *transport-type 'http)
		       (server:ensure-running)
		       ;; Get rid of this
		       (set! sdb:qry (make-sdb:qry (conc *toppath* "/db/strings.db"))) ;; we open the normalization helpers here
		       (set! *fdb*   (filedb:open-db (conc *toppath* "/db/paths.db")))

		       (client:launch))
		      (else ;; (fs)
		       (debug:print 0 "ERROR: Should NOT be getting here! fs transport is no longer supported")
		       (set! *transport-type* 'fs)
		       (set! *megatest-db* (make-dbr:dbstruct path: *toppath* local: #t))))))))))

616
617
618
619
620
621
622

623

624
625
626
627
628
629
630
614
615
616
617
618
619
620
621

622
623
624
625
626
627
628
629







+
-
+







			(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* 
				     "\n         rundir:   " (filedb:get-path *fdb* (db:test-get-rundir test))
								      (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 
1194
1195
1196
1197
1198
1199
1200
1201

1202
1203
1204
1205
1206
1207
1208
1193
1194
1195
1196
1197
1198
1199

1200
1201
1202
1203
1204
1205
1206
1207







-
+








;; this is the socket if we are a client
;; (if (and *runremote*
;; 	 (socket? *runremote*))
;;     (close-socket *runremote*))

(if sdb:qry (sdb:qry 'finalize #f))
(if *fdb*   (filedb:finalize-db! *fdb*))
;; (if *fdb*   (filedb:finalize-db! *fdb*))

(if (not *didsomething*)
    (debug:print 0 help))

;; (if *runremote* (rpc:close-all-connections!))
    
(if (not (eq? *globalexitstatus* 0))