Megatest

;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

;;  strftime('%m/%d/%Y %H:%M:%S','now','localtime')

(use (prefix sqlite3 sqlite3:) srfi-1 posix regex regex-case srfi-69 (srfi 18) 
     posix-extras directory-utils pathname-expand typed-records format  sxml-serializer
     sxml-modifications matchable)

(declare (unit runs))
(declare (uses db))
(declare (uses common))
(declare (uses items))
(declare (uses runconfig))
(declare (uses tests))

			   testmode:    testmode
			   newtal:      newtal
			   itemmaps:    itemmaps
			   ;; prereqs-not-met: prereqs-not-met
			   )))
	(runs:dat-regfull-set! runsdat regfull)
    









	(if (> num-running 0)
            (set! last-time-some-running (current-seconds)))

        (if (> (current-seconds)(+ last-time-some-running (or (configf:lookup *configdat* "setup" "give-up-waiting") 36000)))
            (hash-table-set! *max-tries-hash* tfullname (+ (hash-table-ref/default *max-tries-hash* tfullname 0) 1)))
	;; (debug:print 0 *default-log-port* "max-tries-hash: " (hash-table->alist *max-tries-hash*))

		     "\n  num-retries: " num-retries
                     "\n  reruns:      " reruns
		     "\n  regfull:     " regfull
		     "\n  reglen:      " reglen
		     "\n  length reg:  " (length reg)
                     )

	;; (runs:parallel-runners-mgmt runsdat)

	;; check for hed in waitons => this would be circular, remove it and issue an
	;; error
	(if (member test-name waitons)
	    (begin
	      (debug:print-error 0 *default-log-port* "test " test-name " has listed itself as a waiton, please correct this!")
	      (set! waiton (filter (lambda (x)(not (equal? x hed))) waitons))))

	  (if (and (not (tests:match test-patts (tests:testqueue-get-testname test-record) item-path required: required-tests))
		   (not (null? tal)))
	      (loop (car tal)(cdr tal) reg reruns))
	  (runs:testdat-prereqs-not-met-set! testdat (rmt:get-prereqs-not-met run-id waitons hed item-path mode: testmode itemmaps: itemmaps))

	  ;; This would be a good place to block on homehost load

	  ;; gonna try a strategy change here.
	  ;;
	  ;; check if can run more tests. if yes, continue, if no, rest for 10 seconds, check again
	  ;; repeat until can run more tests
	  ;;
	  ;; look at the test jobgroup and tot jobs running
	  (let loop-can-run-more
	      ((res      (runs:can-run-more-tests runsdat run-id jobgroup max-concurrent-jobs))
	       (remtries 60))
	    (match res
              ((run-more num-running . rem)
	       (if (or run-more
		       (< remtries 1))
		   (begin
		     (if (runs:lownoise "num-running" 30)
			 (debug:print-info 0 *default-log-port* "Have "num-running" tests of max " max-concurrent-jobs))
		     (runs:dat-can-run-more-tests-set! runsdat res)) ;; capture the result and then drop through
		   (begin
		     (if (runs:lownoise "num-running" 10)
			 (debug:print-info 0 *default-log-port* "Can't run more tests, have "num-running" tests of "
					   max-concurrent-jobs " allowed."))
		     (thread-sleep! 5) ;; if we've hit max concurrent jobs take a breather, nb// make this configurable
		     (loop-can-run-more (runs:can-run-more-tests runsdat run-id jobgroup max-concurrent-jobs)
					(- remtries 1)))))))
	      

	  (let ((loop-list (runs:process-expanded-tests runsdat testdat)))
            (if loop-list (apply loop loop-list))))

	 ;; items processed into a list but not came in as a list been processed
	 ;;
	 ((and (list? items)     ;; thus we know our items are already calculated
	       (not   itemdat))  ;; and not yet expanded into the list of things to be done