Megatest

	fossil timeline -n 350 -t ci -F "%h,%a,%b,%t,\"%c\"" > recent-commits.csv


SHELL=/bin/bash
PREFIX=$(PWD)
CSCOPTS=
INSTALL=install
SRCFILES = common.scm launch.scm runconfig.scm	\
           server.scm configf.scm keys.scm		\
           process.scm runs.scm genexample.scm	\
           tdb.scm mt.scm	\
           ezsteps.scm api.scm		\
           subrun.scm archive.scm env.scm		\
           diff-report.scm

;;

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

(declare (unit archive))
(declare (uses debugprint))
(declare (uses mtargs))
(declare (uses common))
(declare (uses commonmod))
(declare (uses configfmod))
(declare (uses rmtmod))

(use (prefix sqlite3 sqlite3:) srfi-1 posix regex regex-case srfi-69
     format md5 message-digest srfi-18)

;;======================================================================
;; Copyright 2006-2012, Matthew Welland.
;; 
;; This file is part of Megatest.
;; 
;;     Megatest is free software: you can redistribute it and/or modify
;;     it under the terms of the GNU General Public License as published by
;;     the Free Software Foundation, either version 3 of the License, or
;;     (at your option) any later version.
;; 
;;     Megatest is distributed in the hope that it will be useful,
;;     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/>.

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

(declare (unit common))
(declare (uses commonmod))
(declare (uses processmod))
(declare (uses configfmod))
(declare (uses rmtmod))
(declare (uses debugprint))
(declare (uses mtargs))
        

(use srfi-1 data-structures posix regex-case (prefix base64 base64:)
     format dot-locking csv-xml z3 udp ;; sql-de-lite
     hostinfo md5 message-digest typed-records directory-utils stack
     matchable regex posix (srfi 18) extras ;; tcp 
     (prefix nanomsg nmsg:)
     (prefix sqlite3 sqlite3:)
     pkts (prefix dbi dbi:)
     )
(use posix-extras pathname-expand files)


(import commonmod
	processmod
	debugprint
	configfmod
	rmtmod
	(prefix mtargs args:))

;; (include "common_records.scm")





;;======================================================================
;; (define *common:telemetry-log-state* 'startup)
;; (define *common:telemetry-log-socket* #f)
;; 
;; (define (common:telemetry-log-open)
;;   (if (eq? *common:telemetry-log-state* 'startup)
;;       (let* ((serverhost (configf:lookup *configdat* "telemetry" "host"))
;;              (serverport (configf:lookup-number *configdat* "telemetry" "port"))
;;              (user (or (get-environment-variable "USER") "unknown"))
;;              (host (or (get-environment-variable "HOST") "unknown")))
;;         (set! *common:telemetry-log-state*
;;               (handle-exceptions
;;                exn
;;                (begin
;;                  (debug:print-info 0 *default-log-port* "common-telemetry-log open udp port failure")
;;                  'broken)
;;                (if (and serverhost serverport user host)
;;                    (let* ((s (udp-open-socket)))
;;                      ;;(udp-bind! s #f 0)
;;                      (udp-connect! s serverhost serverport)
;;                      (set! *common:telemetry-log-socket* s)
;;                      'open)
;;                    'not-needed))))))
;;   
;; (define (common:telemetry-log event #!key (payload '()))
;;   (if (eq? *common:telemetry-log-state* 'startup)
;;       (common:telemetry-log-open))
;; 
;;   (if (eq? 'open *common:telemetry-log-state*)
;;       (handle-exceptions
;;        exn
;;        (begin
;;          (debug:print-info 0 *default-log-port* "common-telemetry-log comms failure ; disabled (no server?)")
;;          ;;(define *common:telemetry-log-state* 'broken-or-no-server-preclose)
;;          ;;(common:telemetry-log-close)
;;          (define *common:telemetry-log-state* 'broken-or-no-server)
;;          (set! *common:telemetry-log-socket* #f)
;;          )
;;        (if (and *common:telemetry-log-socket* event) ;; TODO - filter on event against telemetry.want-events
;;            (let* ((user (or (get-environment-variable "USER") "unknown"))
;;                   (host (or (get-environment-variable "HOST") "unknown"))
;;                   (start (conc "[megatest "event"]"))
;;                   (toppath (or *toppath* "/dev/null"))
;;                   (payload-serialized
;;                    (base64:base64-encode
;;                     (z3:encode-buffer
;;                      (with-output-to-string (lambda () (pp payload))))))
;;                   (msg     (conc user":"host":"start":"(current-process-id)":"(car (argv))":"
;;                                  toppath":"payload-serialized)))
;;              (udp-send *common:telemetry-log-socket* msg))))))
;;   
;; (define (common:telemetry-log-close)
;;   (when (or (member *common:telemetry-log-state* '(broken-or-no-server-preclose open)) *common:telemetry-log-socket*)
;;     (handle-exceptions
;;      exn
;;      (begin
;;        (define *common:telemetry-log-state* 'closed-fail)
;;        (debug:print-info 0 *default-log-port* "common-telemetry-log closure failure")
;;        )
;;      (begin
;;        (define *common:telemetry-log-state* 'closed)
;;        (udp-close-socket *common:telemetry-log-socket*)
;;        (set! *common:telemetry-log-socket* #f)))))

	 status-sym->string
	 common:worse-status-sym
	 common:logpro-exit-code->status-sym

	 save-environment-as-files
	 assoc/default
	 common:read-encoded-string



	 )
	
(import scheme)
(cond-expand
 (chicken-4
  
  (import chicken

(declare (unit configf))
(declare (uses process))
(declare (uses env))
(declare (uses keys))
(declare (uses debugprint))
(declare (uses mtargs))
(declare (uses mtargs.import))
(declare (uses common))
(declare (uses commonmod))
(declare (uses commonmod.import))
(declare (uses processmod))
(declare (uses processmod.import))
(declare (uses configfmod))
(declare (uses configfmod.import))
(declare (uses dbfile))

	 configf:alist->config
	 configf:set-section-var

	 find-and-read-config
	 common:args-get-target
	 configf:eval-string-in-environment






	)

(import scheme
        chicken
	extras
	files
	matchable

	    target)
	(if target
	    (begin
	      (debug:print-error 0 *default-log-port* "Invalid target, spaces or blanks not allowed \"" target "\", target should be: " (string-intersperse keys "/") ", have " tlist " for elements")
	      (if exit-if-bad (exit 1))
	      #f)
	    #f))))




(include "configf-guts.scm")

)

;;======================================================================
;; implementation of context menu that pops up on
;; right click on test cell in Runs & Runs Summary Tabs
;;======================================================================

(declare (unit dashboard-context-menu))
(declare (uses common))
(declare (uses commonmod))
(declare (uses configfmod))
(declare (uses gutils))
(declare (uses rmtmod))
(declare (uses ezsteps))
;; (declare (uses sdb))
;; (declare (uses filedb))

(use canvas-draw)

(use sqlite3 srfi-1 posix regex regex-case srfi-69)
(import (prefix sqlite3 sqlite3:))

(declare (unit dashboard-guimonitor))
(declare (uses common))
(declare (uses keys))
(declare (uses commonmod))
(import commonmod)

;; (include "common_records.scm")
;; (include "db_records.scm")
(include "run_records.scm")

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

;;======================================================================
;; Test info panel
;;======================================================================

(declare (unit dashboard-tests))
(declare (uses common))
(declare (uses commonmod))
(declare (uses configfmod))
(declare (uses debugprint))
(declare (uses rmtmod))
(declare (uses megatestmod))
(declare (uses dbmod))
(declare (uses dbfile))

(declare (uses archivemod.import))
(declare (uses runsmod))
(declare (uses runsmod.import))
(declare (uses launchmod))
(declare (uses launchmod.import))

(declare (uses configf))
(declare (uses common))
(declare (uses keys))

(declare (uses process))
(declare (uses launch))
(declare (uses runs))
(declare (uses dashboard-tests))
(declare (uses tree))

	 db:get-rows
	 db:get-changed-run-ids

	 db:set-sync
	 db:setup

	 db:logpro-dat->csv

	 )
	
(import scheme)
	
(cond-expand
 (chicken-4
  (import chicken

;;     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/>.
;;

(declare (unit diff-report))
(declare (uses common))
(declare (uses debugprint))
(declare (uses rmtmod))
(declare (uses commonmod))
(import commonmod
	rmtmod
	debugprint)
         

;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
;;

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

(declare (unit ezsteps))
(declare (uses commonmod))
(declare (uses common))
(declare (uses configfmod))
(declare (uses debugprint))

(declare (uses runconfig))
(declare (uses rmtmod))
(declare (uses mtargs))
(declare (uses tasksmod))

;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

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

(declare (unit genexample))
(declare (uses mtargs))
(declare (uses debugprint))
(declare (uses common))
(declare (uses commonmod))
(declare (uses configfmod))
(declare (uses rmtmod))

(use posix regex matchable)
(import (prefix mtargs args:)
	commonmod

;;
 
;;======================================================================
;; Run keys, these are used to hierarchially organise tests and run areas
;;======================================================================

(declare (unit keys))
(declare (uses common))
(declare (uses debugprint))
(declare (uses commonmod))
(declare (uses configfmod))
(declare (uses mtargs))

(use sqlite3 srfi-1 posix regex regex-case srfi-69)
(import (prefix sqlite3 sqlite3:)

;;======================================================================
;; launch a task - this runs on the originating host, tests themselves
;;
;;======================================================================

(declare (unit launch))
(declare (uses subrun))
(declare (uses common))
(declare (uses debugprint))
(declare (uses commonmod))
(declare (uses processmod))
(declare (uses configfmod))
(declare (uses configf))
(declare (uses rmtmod))
(declare (uses ezsteps))

;; (include "common.scm")
;; (include "megatest-version.scm")

;; fake out readline usage of toplevel-command
(define (toplevel-command . a) #f)

(declare (uses common))
;; (declare (uses megatest-version))
;; (declare (uses margs))
(declare (uses mtargs))
;; (declare (uses mtargs.import))
(declare (uses debugprint))
(declare (uses debugprint.import))
(declare (uses cookie))
(declare (uses cookie.import))
(declare (uses stml2))
(declare (uses stml2.import))
(declare (uses commonmod))

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

(use sqlite3 srfi-1 posix regex regex-case srfi-69 dot-locking)
(import (prefix sqlite3 sqlite3:))

(declare (unit runs))
(declare (uses common))

(declare (uses runconfig))
(declare (uses commonmod))
(import commonmod)

;; (include "common_records.scm")
;; (include "key_records.scm")

(use sqlite3 srfi-1 posix regex regex-case srfi-69 dot-locking (srfi 18) posix-extras directory-utils
     call-with-environment-variables)

(import (prefix sqlite3 sqlite3:))

(declare (unit mt))
(declare (uses debugprint))
(declare (uses common))
(declare (uses commonmod))
(declare (uses configfmod))

(declare (uses runconfig))
(declare (uses server))
(declare (uses runs))
(declare (uses rmtmod))

;;     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/>.
;;
;
(declare (uses common))
(declare (uses mtargs))
(declare (uses mtargs.import))
(declare (uses debugprint))
(declare (uses debugprint.import))
(declare (uses commonmod))
(declare (uses commonmod.import))
(declare (uses configfmod))

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

(use csv-xml regex)
(declare (unit odsmod))
(declare (uses common))
(declare (uses commonmod))
(declare (uses debugprint))
(declare (uses dbfile))
(declare (uses dbmod))

(module odsmod
	(

(declare (uses tcp-transportmod))
(declare (uses apimod))
(declare (uses servermod))

(module rmtmod
	(
	 rmtmod:send-receive

	 rmt:no-sync-get-lock
	 rmt:no-sync-del!
	 rmt:no-sync-set
	 rmt:no-sync-get/default

	 rmt:get-runs-by-patt
	 rmt:get-testinfo-state-status

;; read a config file, loading only the section pertinent
;; to this run field1val/field2val/field3val ...
;;======================================================================

(use format directory-utils)

(declare (unit runconfig))
(declare (uses common))
(declare (uses debugprint))
(declare (uses commonmod))

(import commonmod
	debugprint)

;; (include "common_records.scm")

(declare (uses dbfile))
(declare (uses dbmod))
(declare (uses megatestmod))
(declare (uses mtmod))
(declare (uses tasksmod))
(declare (uses servermod))

(declare (uses common))

(declare (uses runconfig))
(declare (uses server))
(declare (uses mt))
(declare (uses archive))

(use (prefix sqlite3 sqlite3:) srfi-1 posix regex regex-case srfi-69 (srfi 18) 

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

(declare (unit server))

(declare (uses common))
(declare (uses debugprint))
(declare (uses commonmod))
(declare (uses configfmod))
(declare (uses rmtmod))
(declare (uses launch))
(declare (uses mtargs))

(declare (uses debugprint))
(declare (uses commonmod))
(declare (uses configfmod))
(declare (uses tasksmod))

(declare (uses mt))
(declare (uses common))

(use (prefix sqlite3 sqlite3:) srfi-1 posix regex regex-case srfi-69 (srfi 18) 
     posix-extras directory-utils pathname-expand typed-records format
     call-with-environment-variables)

(import commonmod
	configfmod

;;  1. Run the megatest process and pass it all the needed parameters
;;  2. Every five seconds check for state/status changes and print the info
;;

(declare (uses mtargs))
(declare (uses rmt))
(declare (uses rmtmod))
(declare (uses common))
;; (declare (uses megatest-version))
(declare (uses commonmod))

(use srfi-1 posix srfi-69 srfi-18 regex defstruct)

(use trace)
;; (trace-call-sites #t)

;;======================================================================
;; Database access
;;======================================================================

(declare (unit tdb))
(declare (uses debugprint))
(declare (uses common))
(declare (uses keys))
(declare (uses mt))
(declare (uses commonmod))
(declare (uses mtargs))
(declare (uses rmtmod))

(require-extension (srfi 18) extras tcp)