Megatest

Check-in [8fb98dda5f]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:repl works
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.65-try3
Files: files | file ages | folders
SHA1: 8fb98dda5f358dfeca48c1d054fe474521ed8c45
User & Date: matt on 2019-11-04 04:29:12
Other Links: branch diff | manifest | tags
Context
2019-11-04
04:59
config-lookup -> configf:lookup everywhere now. check-in: b056a2ef64 user: matt tags: v1.65-try3
04:29
repl works check-in: 8fb98dda5f user: matt tags: v1.65-try3
2019-11-03
22:38
wip check-in: 5f97e5ae8d user: matt tags: v1.65-try3
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Modified http-transport-inc.scm from [7456c8c216] to [8e338cca1d].

︙︙
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39



40
41
42
43
44
45
46

;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;     GNU General Public License for more details.
;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

;; Configurations for server
;; (tcp-buffer-size 2048)
;; (max-connections 2048) 

(define (http-transport:make-server-url hostport)
  (if (not hostport)
      #f
      (conc "http://" (car hostport) ":" (cadr hostport))))

(define *server-loop-heart-beat* (current-seconds))

;;======================================================================
;; S E R V E R
;; ======================================================================

;; Call this to start the actual server
;;

(define *db:process-queue-mutex* (make-mutex))

(define (http-transport:run hostn)



  (debug:print 2 *default-log-port* "Attempting to start the server ...")
  (let* ((db              #f) ;;        (open-db)) ;; we don't want the server to be opening and closing the db unnecesarily
	 (hostname        (get-host-name))
	 (ipaddrstr       (let ((ipstr (if (string=? "-" hostn)
					   ;; (string-intersperse (map number->string (u8vector->list (hostname->ip hostname))) ".")
					   (server:get-best-guess-address hostname)
					   #f)))








<
<
<
<

















>
>
>








12
13
14
15
16
17
18




19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45

;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;     GNU General Public License for more details.
;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.





(define (http-transport:make-server-url hostport)
  (if (not hostport)
      #f
      (conc "http://" (car hostport) ":" (cadr hostport))))

(define *server-loop-heart-beat* (current-seconds))

;;======================================================================
;; S E R V E R
;; ======================================================================

;; Call this to start the actual server
;;

(define *db:process-queue-mutex* (make-mutex))

(define (http-transport:run hostn)
  ;; Configurations for server
  (tcp-buffer-size 2048)
  (max-connections 2048) 
  (debug:print 2 *default-log-port* "Attempting to start the server ...")
  (let* ((db              #f) ;;        (open-db)) ;; we don't want the server to be opening and closing the db unnecesarily
	 (hostname        (get-host-name))
	 (ipaddrstr       (let ((ipstr (if (string=? "-" hostn)
					   ;; (string-intersperse (map number->string (u8vector->list (hostname->ip hostname))) ".")
					   (server:get-best-guess-address hostname)
					   #f)))
︙︙

Modified js-path.scm from [c9e6b3b2ac] to [b27a5d1c40].

︙︙
11
12
13
14
15
16
17


18

;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;     GNU General Public License for more details.
;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
;;


(define *java-script-lib* (conc  (common:get-install-area) "/share/js/jquery-3.1.0.slim.min.js")) 








>
>


11
12
13
14
15
16
17
18
19
20

;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;     GNU General Public License for more details.
;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
;;

;; created init-java-script-lib in tests-inc.scm - do we still need this?
(define *java-script-lib* (conc  (common:get-install-area) "/share/js/jquery-3.1.0.slim.min.js"))

Modified megamod.scm from [f09fea9964] to [a27ce3d65b].

︙︙
192
193
194
195
196
197
198
199
200
201
202
203

(include "runs-inc.scm")
(include "server-inc.scm")
(include "subrun-inc.scm")
(include "tasks-inc.scm")
(include "tdb-inc.scm")
(include "tests-inc.scm")
(include "vg-inc.scm")
(include "js-path.scm") ;; load last as it sets a global

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








|





192
193
194
195
196
197
198
199
200
201
202
203

(include "runs-inc.scm")
(include "server-inc.scm")
(include "subrun-inc.scm")
(include "tasks-inc.scm")
(include "tdb-inc.scm")
(include "tests-inc.scm")
(include "vg-inc.scm")
;; (include "js-path.scm") ;; moved into init procedure in tests-inc.scm

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

Modified tests-inc.scm from [ab3e80aad4] to [7684a0f733].

︙︙
18
19
20
21
22
23
24





25
26
27
28
29
30
31

;;
;;======================================================================

;;======================================================================
;; Tests
;;======================================================================







;; Call this one to do all the work and get a standardized list of tests
;;   gets paths from configs and finds valid tests 
;;   returns hash of testname --> fullpath
;;
(define (tests:get-all)
  (let* ((test-search-path   (tests:get-tests-search-path *configdat*)))








>
>
>
>
>








18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36

;;
;;======================================================================

;;======================================================================
;; Tests
;;======================================================================

(define *java-script-lib* #f)

(define (init-java-script-lib)
  (set! *java-script-lib* (conc  (common:get-install-area) "/share/js/jquery-3.1.0.slim.min.js"))
  )

;; Call this one to do all the work and get a standardized list of tests
;;   gets paths from configs and finds valid tests 
;;   returns hash of testname --> fullpath
;;
(define (tests:get-all)
  (let* ((test-search-path   (tests:get-tests-search-path *configdat*)))
︙︙

This page was generated in about 0.128s by Fossil 2.24 [452f8e1ffc] 2024-03-26 15:36:00