Cleaned up after bug squishing. Several minor bugs found. Added all-rmt unit test and made it the default sole unit flow to run

Author: matt

api.scm

@@ -152,7 +152,7 @@
                    ((kill-server)                     (set! *server-run* #f))
 
                    ;; TESTS
-                   ((test-set-state-status-by-id)     (apply db:test-set-state-status-by-id dbstruct params))
+                   ((test-set-state-status-by-id)     (apply mt:test-set-state-status-by-id dbstruct params))
                    ((delete-test-records)             (apply db:delete-test-records dbstruct params))
                    ((delete-old-deleted-test-records) (apply db:delete-old-deleted-test-records dbstruct params))
                    ((test-set-state-status)           (apply db:test-set-state-status dbstruct params))

client.scm

@@ -97,7 +97,7 @@
 				      ((http)(rmt:login-no-auto-client-setup start-res)))))
 		    (if (and start-res
 			     ping-res)
-			(begin
+			(let ((runremote (or area-dat *runremote*))) ;; it might have been generated only a few statements ago
 			  (remote-conndat-set! runremote start-res) ;; (hash-table-set! runremote run-id start-res)
 			  (debug:print-info 2 *default-log-port* "connected to " (http-transport:server-dat-make-url start-res))
 			  start-res)

common.scm

@@ -250,7 +250,7 @@
   (if (not (directory-exists? "logs"))(create-directory "logs"))
   (directory-fold 
    (lambda (file rem)
-     (common:debug-handle-exceptions #t
+     (handle-exceptions
       exn
       (debug:print-info 0 *default-log-port* "failed to rotate log " file ", probably handled by another process.")
       (let* ((fullname (conc "logs/" file))
@@ -293,7 +293,7 @@
              ((and (file-exists? mtconf) (file-exists? dbfile) (not read-only)
                    (eq? (current-user-id)(file-owner mtconf))) ;; safe to run -cleanup-db
               (debug:print 0 *default-log-port* "   I see you are the owner of megatest.config, attempting to cleanup and reset to new version")
-              (common:debug-handle-exceptions #t
+              (handle-exceptions
                exn
                (begin
                  (debug:print 0 *default-log-port* "Failed to switch versions.")
@@ -399,9 +399,9 @@
   (or (getenv "MT_MEGATEST") "megatest"))
 
 (define (common:read-encoded-string instr)
-  (common:debug-handle-exceptions #t
+  (handle-exceptions
    exn
-   (common:debug-handle-exceptions #t
+   (handle-exceptions
     exn
     (begin
       (debug:print-error 0 *default-log-port* "received bad encoded string \"" instr "\", message: " ((condition-property-accessor 'exn 'message) exn))
@@ -842,7 +842,7 @@
 (define (common:get-install-area)
   (let ((exe-path (car (argv))))
     (if (file-exists? exe-path)
-	(common:debug-handle-exceptions #t
+	(handle-exceptions
 	 exn
 	 #f
 	 (pathname-directory
@@ -860,7 +860,7 @@
 	(let ((res (or (and (directory? hed)
 			    (file-write-access? hed)
 			    hed)
-		       (common:debug-handle-exceptions #t
+		       (handle-exceptions
 			exn
 			#f
 			(create-directory hed #t)))))
@@ -876,14 +876,14 @@
 (define (common:get-youngest glob-list)
   (let ((all-files (apply append
 			  (map (lambda (patt)
-				 (common:debug-handle-exceptions #t
+				 (handle-exceptions
 				     exn
 				     '()
 				   (glob patt)))
 			       glob-list))))
     (fold (lambda (fname res)
 	    (let ((last-mod (car res))
-		  (curmod   (common:debug-handle-exceptions #t
+		  (curmod   (handle-exceptions
 				exn
 				0
 			      (file-modification-time fname))))
@@ -1235,7 +1235,7 @@
 (define nice-path common:nice-path)
 
 (define (common:read-link-f path)
-  (common:debug-handle-exceptions #t
+  (handle-exceptions
       exn
       (begin
 	(debug:print-error 0 *default-log-port* "command \"/bin/readlink -f " path "\" failed.")

common_records.scm

@@ -30,7 +30,7 @@
 
 ;; (define-syntax common:handle-exceptions
 ;;   (syntax-rules ()
-;;     ((_ exn-in errstmt ...)(common:debug-handle-exceptions #t exn-in errstmt ...))))
+;;     ((_ exn-in errstmt ...)(handle-exceptions exn-in errstmt ...))))
 
 (define-syntax common:debug-handle-exceptions
   (syntax-rules ()

configf.scm

@@ -51,7 +51,7 @@
 		    var value metadata: metadata)))
 
 (define (config:eval-string-in-environment str)
-  (common:debug-handle-exceptions #t
+  (handle-exceptions
    exn
    (begin
      (debug:print-error 0 *default-log-port* "problem evaluating \"" str "\" in the shell environment")
@@ -111,7 +111,7 @@
 				;; ((rget)           (conc "(lambda (ht)(runconfigs-get ht \"" cmd "\"))"))
 				(else "(lambda (ht)(print \"ERROR\") \"ERROR\")"))))
 		;; (print "fullcmd=" fullcmd)
-		(common:debug-handle-exceptions #t
+		(handle-exceptions
 		 exn
 		 (begin
 		   (debug:print 0 *default-log-port* "WARNING: failed to process config input \"" l "\"")

dashboard-tests.scm

@@ -467,15 +467,15 @@
                ;; needed. Revisit this.
 	       (runconfig  (let ((runconfigf (conc  *toppath* "/runconfigs.config"))) ;; no rush but it would be good to convert this call to use runconfig:read
 	 		     (if (file-exists? runconfigf)
-	 			 (common:debug-handle-exceptions #t
+	 			 (handle-exceptions
                                    exn
                                    #f  ;; do nothing, just keep on trucking ....
                                    (setup-env-defaults runconfigf run-id (make-hash-table) keydat environ-patt: keystring))
 	 			 (make-hash-table))))
 	       (testconfig    (begin
 				;; (runs:set-megatest-env-vars run-id inrunname: runname testname: test-name itempath: item-path)
 				(runs:set-megatest-env-vars run-id inkeyvals: keydat inrunname: runname intarget: keystring testname: testname itempath: item-path) ;; these may be needed by the launching process
-				(common:debug-handle-exceptions #t
+				(handle-exceptions
 				 exn  ;; NOTE: I've no idea why this was written this way. Research, study and fix needed!
 				 (tests:get-testconfig (db:test-get-testname testdat) (db:test-get-item-path testdat) test-registry #f)
 				 (tests:get-testconfig (db:test-get-testname testdat) item-path test-registry #t))))
@@ -515,7 +515,7 @@
 						       request-update))
 				    (newtestdat (if need-update 
 						    ;; NOTE: BUG HIDER, try to eliminate this exception handler
-						    (common:debug-handle-exceptions #t
+						    (handle-exceptions
 						     exn 
 						     (debug:print-info 0 *default-log-port* "test db access issue in examine test for run-id " run-id ", test-id " test-id ": " ((condition-property-accessor 'exn 'message) exn))
 						     (rmt:get-test-info-by-id run-id test-id )))))

dashboard.scm

@@ -1901,7 +1901,7 @@ Misc
 	 (result-child #f))
     (if (and (file-exists? source)
 	     (file-read-access? source))
-	(common:debug-handle-exceptions #t
+	(handle-exceptions
 	 exn
 	 (begin
 	   (print-call-chain)
@@ -1913,7 +1913,7 @@ Misc
 	  (debug:print 0 *default-log-port* "ERROR: cannot find file to load: \"" source "\" for user view " view-name)))
     ;; now run the user supplied definition for the tab view
     (if success
-	(common:debug-handle-exceptions #t
+	(handle-exceptions
 	 exn
 	 (begin
 	   (print-call-chain)
@@ -1930,7 +1930,7 @@ Misc
     (if success
 	(dboard:commondat-add-updater commondat
 				      (lambda ()
-					(common:debug-handle-exceptions #t
+					(handle-exceptions
 					 exn
 					 (begin
 					   (print-call-chain)
@@ -2717,7 +2717,7 @@ Misc
 ;; (tasks:open-db)
 
 (define (dashboard:get-youngest-run-db-mod-time dbdir)
-  (common:debug-handle-exceptions #t
+  (handle-exceptions
    exn
    (begin
      (debug:print 0 *default-log-port* "WARNING: error in accessing databases in get-youngest-run-db-mod-time: " ((condition-property-accessor 'exn 'message) exn) " db-dir="dbdir)
@@ -3015,7 +3015,7 @@ Misc
 					(lambda (res t var val)
 					  (cons (vector t var val) res))
 					'() db all-dat-qrystr)))
-		     (let ((zeropt (common:debug-handle-exceptions #t
+		     (let ((zeropt (handle-exceptions
 				    exn
 				    #f
 				    (sqlite3:first-row db all-dat-qrystr))))

datashare.scm

@@ -230,7 +230,7 @@ Version: " megatest-fossil-hash)) ;; "
 	       (writeable (file-write-access? dbpath))
 	       (dbexists  (file-exists? dbpath))
 	       (handler   (make-busy-timeout 136000)))
-	  (common:debug-handle-exceptions #t
+	  (handle-exceptions
 	   exn
 	   (begin
 	     (debug:print 2 *default-log-port* "ERROR: problem accessing db " dbpath
@@ -245,7 +245,7 @@ Version: " megatest-fossil-hash)) ;; "
 	(print "ERROR: invalid path for storing database: " path))))
 
 (define (open-run-close-exception-handling proc idb . params)
-  (common:debug-handle-exceptions #t
+  (handle-exceptions
    exn
    (let ((sleep-time (random 30))
          (err-status ((condition-property-accessor 'sqlite3 'status #f) exn)))

db.scm

@@ -76,7 +76,7 @@
 ;; convert to -inline 
 ;;
 (define (db:first-result-default db stmt default . params)
-  (common:debug-handle-exceptions #t
+  (handle-exceptions
    exn
    (let ((err-status ((condition-property-accessor 'sqlite3 'status #f) exn)))
      ;; check for (exn sqlite3) ((condition-property-accessor 'exn 'message) exn)
@@ -147,7 +147,7 @@
 	(debug:print-info 0 *default-log-port* *api-process-request-count* " parallel api requests being processed in process " (current-process-id) ", throttling access"))
     (if (common:low-noise-print 600 (conc "parallel-api-requests" *max-api-process-requests*))
 	(debug:print-info 2 *default-log-port* "Parallel api request count: " *api-process-request-count* " max parallel requests: " *max-api-process-requests*))
-    (common:debug-handle-exceptions #t
+    (handle-exceptions
      exn
      (begin
        (print-call-chain (current-error-port))
@@ -192,7 +192,7 @@
 ;;
 (define (db:dbfile-path . junk) ;;  run-id)
   (let* ((dbdir           (common:get-db-tmp-area)))
-    (common:debug-handle-exceptions #t
+    (handle-exceptions
      exn
      (begin
        (debug:print-error 0 *default-log-port* "Couldn't create path to " dbdir)
@@ -261,7 +261,7 @@
 ;;   (let* ((dbfile       (db:dbfile-path run-id)) ;; (conc toppath "/db/" run-id ".db"))
 ;;          (dbexists     (file-exists? dbfile))
 ;;          (db           (db:lock-create-open dbfile (lambda (db)
-;;                                                      (common:debug-handle-exceptions #t
+;;                                                      (handle-exceptions
 ;;                                                       exn
 ;;                                                       (begin
 ;;                                                         ;; (release-dot-lock dbpath)
@@ -542,7 +542,7 @@
      ;;  NOPE: apply this same approach to all db files
      ;;
      (else ;; ((equal? fname "megatest.db") ;; this file can be regenerated if needed
-      (common:debug-handle-exceptions #t
+      (handle-exceptions
        exn
        (begin
 	 ;; (db:move-and-recreate-db dbdat)
@@ -586,7 +586,7 @@
 ;;    IFF field-name exists
 ;;
 (define (db:sync-tables tbls last-update fromdb todb . slave-dbs)
-  (common:debug-handle-exceptions #t
+  (handle-exceptions
    exn
    (begin
      (debug:print 0 *default-log-port* "EXCEPTION: database probably overloaded or unreadable in db:sync-tables.")
@@ -1053,7 +1053,7 @@
       #f))
 
 (define (open-run-close-exception-handling proc idb . params)
-  (common:debug-handle-exceptions #t
+  (handle-exceptions
    exn
    (let ((sleep-time (random 30))
 	 (err-status ((condition-property-accessor 'sqlite3 'status #f) exn)))
@@ -3678,7 +3678,7 @@
 	  (let* ((dbpath (db:dbdat-get-path dbdat))
 		 (db     (db:dbdat-get-db   dbdat)) ;; we'll return this so (db:delay--if-busy can be called inline
 		 (dbfj   (conc dbpath "-journal")))
-	    (if (common:debug-handle-exceptions #t
+	    (if (handle-exceptions
 		 exn
 		 (begin
 		   (debug:print-info 0 *default-log-port* "WARNING: failed to test for existance of " dbfj)

launch.scm

@@ -365,7 +365,7 @@
 		    (begin
 		      (for-each
 		       (lambda (pid)
-			 (common:debug-handle-exceptions #t
+			 (handle-exceptions
 			  exn
 			  (begin
 			    (debug:print-info 0 *default-log-port* "Unable to kill process with pid " pid ", possibly already killed.")
@@ -380,7 +380,7 @@
 			  (thread-sleep! 5)
 			  ;; (if (process:process-alive? pid)
 			  (map (lambda (pid-num)
-				 (common:debug-handle-exceptions #t
+				 (handle-exceptions
 				  exn
 				  #f
 				  (process-signal pid-num signal/kill)))
@@ -848,14 +848,14 @@
 	  (begin
 	    (if (not (file-exists? linktree))
 		(begin
-		  (common:debug-handle-exceptions #t
+		  (handle-exceptions
 		   exn
 		   (begin
 		     (debug:print-error 0 *default-log-port* "Something went wrong when trying to create linktree dir at " linktree)
 		     (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
 		     (exit 1))
 		   (create-directory linktree #t))))
-	    (common:debug-handle-exceptions #t
+	    (handle-exceptions
 	     exn
 	     (begin
 	       (debug:print-error 0 *default-log-port* "Something went wrong when trying to create link to linktree at " *toppath*)
@@ -954,7 +954,7 @@
     ;; create the directory for the tests dir links, this is needed no matter what...
     (if (and (not (directory-exists? lnkbase))
 	     (not (file-exists? lnkbase)))
-	(common:debug-handle-exceptions #t
+	(handle-exceptions
 	 exn
 	 (begin
 	   (debug:print-error 0 *default-log-port* "Problem creating linktree base at " lnkbase)
@@ -973,15 +973,15 @@
     (if (not not-iterated) ;; i.e. iterated
 	(let ((iterated-parent  (pathname-directory (conc lnkpath "/" item-path))))
 	  (debug:print-info 2 *default-log-port* "Creating iterated parent " iterated-parent)
-	  (common:debug-handle-exceptions #t
+	  (handle-exceptions
 	   exn
 	   (begin
 	     (debug:print-error 0 *default-log-port* " Failed to create directory " iterated-parent ((condition-property-accessor 'exn 'message) exn) ", exiting")
 	     (exit 1))
 	   (create-directory iterated-parent #t))))
 
     (if (symbolic-link? lnkpath) 
-	(common:debug-handle-exceptions #t
+	(handle-exceptions
 	 exn
 	 (begin
 	   (debug:print-error 0 *default-log-port* " Failed to remove symlink " lnkpath ((condition-property-accessor 'exn 'message) exn) ", exiting")
@@ -990,7 +990,7 @@
 
     (if (not (or (file-exists? lnkpath)
 		 (symbolic-link? lnkpath)))
-	(common:debug-handle-exceptions #t
+	(handle-exceptions
 	 exn
 	 (begin
 	   (debug:print-error 0 *default-log-port* " Failed to create symlink " lnkpath ((condition-property-accessor 'exn 'message) exn) ", exiting")
@@ -1023,7 +1023,7 @@
 		  (not (directory-exists? toptest-path)))
 	      (begin
 		(debug:print-info 2 *default-log-port* "Creating " toptest-path " and link " lnkpath)
-		(common:debug-handle-exceptions #t
+		(handle-exceptions
 		 exn
 		 #f ;; don't care to catch and deal with errors here for now.
 		 (create-directory toptest-path #t))
@@ -1035,7 +1035,7 @@
 	(begin ;; (let ((lnktarget (conc lnkpath "/" item-path)))
 	  (debug:print 2 *default-log-port* "Setting up sub test run area")
 	  (debug:print 2 *default-log-port* " - creating run area in " test-path)
-	  (common:debug-handle-exceptions #t
+	  (handle-exceptions
 	   exn
 	   (begin
 	     (debug:print-error 0 *default-log-port* " Failed to create directory " test-path ((condition-property-accessor 'exn 'message) exn) ", exiting")
@@ -1046,7 +1046,7 @@
 		       "                   to: " lnktarget)
 
 	  ;; If there is already a symlink delete it and recreate it.
-	  (common:debug-handle-exceptions #t
+	  (handle-exceptions
 	   exn
 	   (begin
 	     (debug:print-error 0 *default-log-port* " Failed to re-create link " lnktarget ((condition-property-accessor 'exn 'message) exn) ", exiting")