Megatest

(declare (uses testsmod))
(declare (uses vgmod))

(module rmtmod
	*
	
(import scheme chicken data-structures extras)
(import
 (prefix sqlite3 sqlite3:)

	call-with-environment-variables
 csv
 format
 http-client
 intarweb
 irregex
 matchable
 ports
 posix
 regex
 s11n
 spiffy
 spiffy-directory-listing
 spiffy-request-vars
 srfi-1
 srfi-13
 srfi-18
 srfi-69
 stack
 stml2
 typed-records
 uri-common
 z3
 )

;; (import apimod)
(import archivemod)
(import clientmod)
(import commonmod)
(import configfmod)
(import dbmod)

(include "task_records.scm")
(include "test_records.scm")
(include "run_records.scm")

;;======================================================================
;; L O C K I N G   M E C H A N I S M S 
;;======================================================================
(include "f2.scm")

;; General data
;;
(define (dcommon:general-info)
  (let ((general-matrix (iup:matrix
			 #:alignment1 "ALEFT"
			 #:expand "YES" ;; "HORIZONTAL"

						    (areadat-conndat-set! areadat #f))
						;; Killing associated server to allow clean retry.")
						;; (tasks:kill-server-run-id run-id)  ;; better to kill the server in the logic that called this routine?
						(mutex-unlock! *http-mutex*)
					     ;;; (signal (make-composite-condition
					     ;;;          (make-property-condition 'commfail 'message "failed to connect to server")))
					     ;;; "communications failed"
					     (db:obj->string #f)) ;; end of the error handling part
					    (with-input-from-request ;; was dat
					     fullurl 
					     (list (cons 'key (or *server-id* "thekey"))
						   (cons 'cmd cmd)
						   (cons 'params sparams))
					     read-string))
					  transport: 'http)

	 (debug:print-info 11 *default-log-port* "got res=" res)
	 (if (vector? res)
	     (if (vector-ref res 0) ;; this is the first flag or the second flag?
		 res ;; this is the *inner* vector? seriously? why?
                 (if (debug:debug-mode 11)
                     (let ((call-chain (get-call-chain))) ;; note: this code also called in nmsg-transport - consider consolidating it
                       (print-call-chain (current-error-port))
                       (debug:print-error 11 *default-log-port* "error above occured at server, res=" res) ;; there is NO exn at this time  " message: " ((condition-property-accessor 'exn 'message) exn))
                       (debug:print 11 *default-log-port* " server call chain:")
                       (pp (vector-ref res 1) (current-error-port))
                       (signal (vector-ref res 0)))
                     res))
	     (signal (make-composite-condition
		      (make-property-condition 
		       'timeout

            ;;(close-idle-connections!)
	    #t))
	#f)))

;; http-transport:server-dat definition moved to common_records.scm
;; bunch of small functions factored out of send-receive to make debug easier
;;
(include "f1.scm")
)