Index: Makefile ================================================================== --- Makefile +++ Makefile @@ -31,11 +31,11 @@ cgisetup/models/pgdb.scm # module source files # ftail.scm rmtmod.scm commonmod.scm removed MSRCFILES = ducttape-lib.scm pkts.scm stml2.scm cookie.scm mutils.scm \ - mtargs.scm commonmod.scm dbmod.scm + mtargs.scm commonmod.scm dbmod.scm adjutant.scm GUISRCF = dashboard-context-menu.scm dashboard-tests.scm \ dashboard-guimonitor.scm gutils.scm dcommon.scm tree.scm \ vg.scm Index: TODO ================================================================== --- TODO +++ TODO @@ -17,10 +17,61 @@ NOTE: This file gets copied occasionally into the wiki as "Roadmap". Do not make changes in the wiki, they will be lost! See the file "DONE" to see completed items. +FIXME +==== + +.dump +---------------- +WARNING: disk disk0 at path "/mfs/tmp/archive" is not a directory - ignoring it. + +Warning (#): in thread: unbound variable: block-id + + Call history: + + common.scm:693: hash-table-ref/default + common.scm:694: current-seconds + common.scm:697: hash-table-set! + common.scm:2232: debug:print + common_records.scm:140: debug:debug-mode + common_records.scm:141: with-output-to-port + common.scm:2245: directory? + common.scm:2246: common:low-noise-print + common.scm:692: g2022 + common.scm:692: g2022 + common.scm:692: string-intersperse + common.scm:693: hash-table-ref/default + common.scm:694: current-seconds + common.scm:2261: debug:print + common_records.scm:140: debug:debug-mode + archive.scm:125: debug:print <-- +INFO: (0) Estimating disk space usage for scriptinc/: 184 + +Error: uncaught exception: # + + Call history: + + common.scm:1299: ##sys#get-keyword + common.scm:1299: call-with-current-continuation + common.scm:1299: with-exception-handler + common.scm:1299: ##sys#call-with-values + common.scm:1304: thunk + common.scm:1310: file-exists? + common.scm:1299: k2554 + common.scm:1299: g2558 + runs.scm:2438: common:get-disk-space-used + common.scm:2128: conc + common.scm:2128: with-input-from-pipe + runs.scm:2438: debug:print-info + common_records.scm:235: debug:debug-mode + common_records.scm:236: port? + common_records.scm:236: with-output-to-port + runs.scm:2443: thread-join! <-- +Press any key to continue +---------------- TODO ==== WW15 ADDED adjutant.scm Index: adjutant.scm ================================================================== --- /dev/null +++ adjutant.scm @@ -0,0 +1,34 @@ +;;====================================================================== +;; Copyright 2017, 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 . + +;;====================================================================== + +(declare (unit adjutant)) + +(module adjutant + * + +(import scheme chicken data-structures extras files) +(import (prefix sqlite3 sqlite3:) posix typed-records srfi-18 srfi-69 + md5 message-digest + regex srfi-1) + +(define (adjutant-run) + (print "Running the adjutant!")) + +) Index: common.scm ================================================================== --- common.scm +++ common.scm @@ -2190,12 +2190,13 @@ ;; check space in dbdir and in megatest dir ;; returns: ok/not dbspace required-space ;; (define (common:check-db-dir-space) (let* ((required (string->number + ;; default is 1GB (or actually a billion bytes) This is the number of 1 kB blocks. (or (configf:lookup *configdat* "setup" "dbdir-space-required") - "100000"))) + "1000000"))) (dbdir (common:get-db-tmp-area)) ;; (db:get-dbdir)) (tdbspace (common:check-space-in-dir dbdir required)) (mdbspace (common:check-space-in-dir *toppath* required))) (sort (list tdbspace mdbspace) (lambda (a b) (< (cadr a)(cadr b)))))) @@ -2214,13 +2215,16 @@ (exit 1))))) ;; paths is list of lists ((name path) ... ) ;; (define (common:get-disk-with-most-free-space disks minsize) - (let ((best #f) + (let* ((best #f) (bestsize 0) - (min-inodes (or (string->number (if (configf:lookup *configdat* "setup" "min_inodes") (configf:lookup *configdat* "setup" "min_inodes") "0")) 0))) + (default-min-inodes-string "1000000") + (default-min-inodes (string->number default-min-inodes-string)) + (min-inodes (or (string->number (if (configf:lookup *configdat* "setup" "min_inodes") (configf:lookup *configdat* "setup" "min_inodes") default-min-inodes-string)) default-min-inodes))) + (for-each (lambda (disk-num) (let* ((dirpath (cadr (assoc disk-num disks))) (freespc (cond ((not (directory? dirpath)) @@ -2252,10 +2256,11 @@ -1) (else (get-free-inodes dirpath)))) ;;(free-inodes (get-free-inodes dirpath)) ) + (debug:print 2 *default-log-port* "INFO: disk " disk-num " path " dirpath " free space " freespc " free inodes " free-inodes) (if (and (> freespc bestsize)(> free-inodes min-inodes )) (begin (set! best (cons disk-num dirpath)) (set! bestsize freespc))) ;;(print "Processing: " disk-num " bestsize: " bestsize " best: " best " freespc: " freespc " min-inodes: " min-inodes " free-inodes: " free-inodes) Index: docs/manual/installation.txt ================================================================== --- docs/manual/installation.txt +++ docs/manual/installation.txt @@ -20,9 +20,32 @@ Dependencies ~~~~~~~~~~~~ Chicken scheme and a number of "eggs" are required for building -Megatest. See the script installall.sh in the utils directory of the -source distribution for an automated way to install everything -needed for building Megatest on Linux. +Megatest. In the v1.66 and beyond assistance to create the build +system is built into the Makefile. + +.Installation steps (overview) +------------------------------------- +./configure +make chicken +setup.sh make -j install +------------------------------------- + +Or install the needed build system manually: + +. Chicken scheme from http://call-cc.org +. IUP from http://webserver2.tecgraf.puc-rio.br/iup/ +. CD from http://webserver2.tecgraf.puc-rio.br/cd/ +. IM from https://webserver2.tecgraf.puc-rio.br/im/ +. ffcall from http://webserver2.tecgraf.puc-rio.br/iup/ +. Nanomsg from https://nanomsg.org/ (NOTE: Plan is to eliminate nanomsg dependency). +. Needed eggs (look at the eggs lists in the Makefile) + +Then follow these steps: +.Installation steps (self-built chicken scheme build system) +------------------------------------- +./configure +make -j install +------------------------------------- Index: docs/manual/megatest_manual.html ================================================================== --- docs/manual/megatest_manual.html +++ docs/manual/megatest_manual.html @@ -767,15 +767,15 @@ -
-

Road Map

-
-

Note 1: This road-map continues to evolve and subject to change without notice.

-
-

Here is a smattering of ideas for Megatest 2.0

-
    -
  1. -

    -Add variable $MT_RUNPATH = $MT_LINKTREE/$MT_TARGET/$MT_RUNNAME -

    -
    2. -
-
-
-
[db]
-api legacy|new
-
-
    -
  1. -

    -One big lesson from the 1.63-1.65 generation was that the main.db, 1.db … model was really good at scaling. I’d like to combine that model with the current also-very-good model. Obviously this is a disruptive change. I think making the old model the default and the new model an option for at least one generation would be fair. -

    -
    2. -
  2. -

    -Rigorous megatest.config and runconfig.config caching. -

    -
      -
    1. -

      -Cache the configs in $MT_RUNPATH -

      -
      2. -
    2. -

      -Following invocations of –run, -rerun* will calculate the new config but only overwrite the cached file IF changed -

      -
      3. -
    -
    3. -
  3. -

    -If the cached file changes ALL existing tests go from COMPLETED → STALE, I’m not sure what to do about RUNNING tests -

    -
    4. -
  4. -

    -!VARS in runconfigs are not exported to the environment. They are accessed via rget as if the ! was not there. -

    -
    5. -
  5. -

    -Per test copy commands (crude example below is not correct). -

    -
    6. -
-
-
-
[testcopy]
-%/iind% unison SRC DEST
-% cp –r SRC DEST
-
-
    -
  1. -

    -Test management via pkts (optional?) -

    -
      -
    1. -

      -Control pkt types: run, kill, rerunclean, clean, archive, status? -

      -
      2. -
    2. -

      -Status pkt types: ack, step, status_change -

      -
      3. -
    -
    2. -
  2. -

    -Add nanomsg as a transport option -. -

    -
    3. -
-
-
-

RFC M01: Add ability to move runs to other Areas

-

Purpose: allow shrinking megatest.db data by moving runs to an alternate - Megatest area with same keys.

-

Method: extend db sync to take a different megatest area as a destination.

-

Design:

-
    -
  1. -

    -add param -destination [area|path]. when specified runs are copied to new - area and removed from local db. -

    -
    2. -
  2. -

    -the data move would involve these steps -

    -
      -
    1. -

      -copy the run data to destination area megatest.db -

      -
      2. -
    2. -

      -mark the run records as deleted, do not remove the run data on disk -

      -
      3. -
    -
    3. -
  3. -

    -accessing the data would be by running dashboard in the satellite area -

    -
    4. -
  4. -

    -future versions of Megatest dashboard should support displaying areas in a - merged way. -

    -
    5. -
  5. -

    -some new controls would be supported in the config -

    -
      -
    1. -

      -[setup] ⇒ allow-runs [no|yes] ⇐= used to disallow runs -

      -
      2. -
    2. -

      -[setup] ⇒ auto-migrate=[areaname|path] ⇐= used to automatically - migrate data to a satellite area. -

      -
      3. -
    -
    6. -
-

Branch: This work is taking place on branch v1.65-reduce-records

-
-
-

RFC M02: Move data into completed-runs.db

-

Purpose: shrink megatest.db data to enable lower load and higher performance.

-

Method: add a completed-runs.db and automatically move runs data from megatest.db to that db

-

Design:

-
    -
  1. -

    -completed-runs.db is a full megatest database with complete schema -

    -
    2. -
  2. -

    -the data move would involve these steps -

    -
      -
    1. -

      -copy the run data to completed-runs.db -

      -
      2. -
    2. -

      -remove the run data, first from /tmp/…/megatest.db and /tmp/…/megatest_ref.db, followed by megatest.db -

      -
      3. -
    -
    3. -
  3. -

    -accessing the data would be unchanged for most operations. -

    -
    4. -
  4. -

    -a mode -full-db will be added which when specified would attach the completed-runs.db to megatest.db before doing the query -

    -
    5. -
  5. -

    -mechanisms for moving runs to/from the megatest.db would be added -

    -
      -
    1. -

      --reduce-records ⇒ move runs to completed-runs.db -

      -
      2. -
    2. -

      --restore-records ⇒ move runs from completed-runs.db to megatest.db -

      -
      3. -
    -
    6. -
-

Branch: This work is taking place on branch v1.65-reduce-records

-
-
-

RFC M03: Automatic homehost migrations

-

Purpose: Automatically migrate homehost.

-

Method: Check that there are no tests running, launched or remotehoststart in past ½ hour then if not on homehost migrate the db to current host

-

Design:

-
    -
  1. -

    -Check that the system is quiescent, i.e. that there are no runs in flight or recently run -

    -
    2. -
  2. -

    -Create a lock -

    -
    3. -
  3. -

    -Migrate the /tmp cache db to the current host -

    -
    4. -
  4. -

    -Update the .homehost file -

    -
    5. -
  5. -

    -Remove the lock -

    -
    6. -
-

Branch: This work not yet started

-
-
-

Architecture Refactor

-
-

Goals

-
    -
  1. -

    -Reduce load on the file system. Sqlite3 files on network filesystem can be - a burden. [DONE] -

    -
    2. -
  2. -

    -Reduce number of servers and frequency of start/stop. This is mostly an - issue of clutter but also a reduction in "moving parts". [DONE] -

    -
    3. -
  3. -

    -Coalesce activities to a single home host where possible. Give the user - feedback that they have started the dashboard on a host other than the - home host. [DONE] -

    -
    4. -
  4. -

    -Reduce number of processes involved in managing running tests. -

    -
    5. -
-
-
-

Changes Needed

-
    -
  1. -

    -ACID compliant db will be on /tmp and synced to megatest.db with a five - second max delay. [DONE] -

    -
    2. -
  2. -

    -Read/writes to db for processes on homehost will go direct to /tmp - megatest.db file. [DONE] -

    -
    3. -
  3. -

    -Read/wites fron non-homehost processes will go through one server. Bulk - reads (e.g. for dashboard or list-runs) will be cached on the current host - in /tmp and synced from the home megatest.db in the testsuite area. [DONE] -

    -
    4. -
  4. -

    -Db syncs rely on the target db file timestame minus some margin. [DONE] -

    -
    5. -
  5. -

    -Since bulk reads do not use the server we can switch to simple RPC for the - network transport. [DONE] -

    -
    6. -
  6. -

    -Test running manager process extended to manage multiple running tests. -

    -
    7. -
-
-
-
-

Current Items

-
-

ww05 - migrate to inmem-db

-
    -
  1. -

    -Switch to inmem db with fast sync to on disk db’s [DONE] -

    -
    2. -
  2. -

    -Server polls tasks table for next action -

    -
      -
    1. -

      -Task table used for tracking runner process [Replaced by mtutil] -

      -
      2. -
    2. -

      -Task table used for jobs to run [Replaced by mtutil] -

      -
      3. -
    3. -

      -Task table used for queueing runner actions (remove runs, - cleanRunExecute, etc) [Replaced by mtutil] -

      -
      4. -
    -
    3. -
-

shifting, note that the preceding blank line is needed.

-
-
-

Index

@@ -3201,12 +3379,12 @@
Index: docs/manual/megatest_manual.txt ================================================================== --- docs/manual/megatest_manual.txt +++ docs/manual/megatest_manual.txt @@ -1,9 +1,9 @@ The Megatest Users Manual ========================= Matt Welland -v1.0, April 2012 +v1.5, June 2020 :doctype: book [preface] Preface @@ -11,11 +11,11 @@ This book is organised as three sub-books; getting started, writing tests and reference. .License ---------------------------- - Copyright 2006-2017, Matthew Welland. + Copyright 2006-2020, Matthew Welland. This document 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 @@ -38,11 +38,11 @@ The Megatest project was started for two reasons, the first was an immediate and pressing need for a generalized tool to manage a suite of regression tests and the second was the fact that I had written or maintained several such tools at different companies over the years. I thought a single open source tool, flexible enough to meet the needs -of any team doing continuous integrating and or running a complex +of any team doing continuous integration and or running a complex suite of tests for release qualification would solve some problems for me and for others. -- Matt Welland, original author of the Megatest tool suite. @@ -100,10 +100,12 @@ sqlite3 database. Megatest has been used with the Intel Netbatch and lsf (also known as openlava) batch systems and it should be straightforward to use it with other similar systems. include::overview.txt[] + +include::plan.txt[] include::installation.txt[] include::getting_started.txt[] @@ -123,13 +125,13 @@ ["graphviz", "server.png"] ---------------------------------------------------------------------- include::server.dot[] ---------------------------------------------------------------------- -include::plan.txt[] +// include::plan.txt[] // to allow the getting_started.txt to be a stand-alone document use level -shifting, note that the preceding blank line is needed. +// shifting, note that the preceding blank line is needed. // :leveloffset: 2 // [appendix] // Example Appendix Index: docs/manual/plan.txt ================================================================== --- docs/manual/plan.txt +++ docs/manual/plan.txt @@ -1,232 +1,163 @@ -Road Map --------- - -// 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 . - -// Copyright 2006-2012, Matthew Welland. - -Note 1: This road-map continues to evolve and subject to change without notice. - -Here is a smattering of ideas for Megatest 2.0 -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -. Add variable $MT_RUNPATH = $MT_LINKTREE/$MT_TARGET/$MT_RUNNAME ----------------- -[db] -api legacy|new ----------------- -. One big lesson from the 1.63-1.65 generation was that the main.db, 1.db … model was really good at scaling. I’d like to combine that model with the current also-very-good model. Obviously this is a disruptive change. I think making the old model the default and the new model an option for at least one generation would be fair. -. Rigorous megatest.config and runconfig.config caching. -.. Cache the configs in $MT_RUNPATH -.. Following invocations of –run, -rerun* will calculate the new config but only overwrite the cached file IF changed -. If the cached file changes ALL existing tests go from COMPLETED -> STALE, I’m not sure what to do about RUNNING tests -. !VARS in runconfigs are not exported to the environment. They are accessed via rget as if the ! was not there. -. Per test copy commands (crude example below is not correct). ----------------- -[testcopy] -%/iind% unison SRC DEST -% cp –r SRC DEST ----------------- -. Test management via pkts (optional?) -.. Control pkt types: run, kill, rerunclean, clean, archive, status? -.. Status pkt types: ack, step, status_change -. Add nanomsg as a transport option -. - -RFC M01: Add ability to move runs to other Areas -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -*Purpose*: allow shrinking megatest.db data by moving runs to an alternate - Megatest area with same keys. - -*Method*: extend db sync to take a different megatest area as a destination. - -*Design*: - -. add param -destination [area|path]. when specified runs are copied to new - area and removed from local db. -. the data move would involve these steps -.. copy the run data to destination area megatest.db -.. mark the run records as deleted, do not remove the run data on disk -. accessing the data would be by running dashboard in the satellite area -. future versions of Megatest dashboard should support displaying areas in a - merged way. -. some new controls would be supported in the config -.. [setup] => allow-runs [no|yes] <== used to disallow runs -.. [setup] => auto-migrate=[areaname|path] <== used to automatically - migrate data to a satellite area. - -*Branch*: This work is taking place on branch v1.65-reduce-records - -RFC M02: Move data into completed-runs.db -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -*Purpose*: shrink megatest.db data to enable lower load and higher performance. - -*Method*: add a completed-runs.db and automatically move runs data from megatest.db to that db - -*Design*: - -. completed-runs.db is a full megatest database with complete schema -. the data move would involve these steps -.. copy the run data to completed-runs.db -.. remove the run data, first from /tmp/…/megatest.db and /tmp/…/megatest_ref.db, followed by megatest.db -. accessing the data would be unchanged for most operations. -. a mode -full-db will be added which when specified would attach the completed-runs.db to megatest.db before doing the query -. mechanisms for moving runs to/from the megatest.db would be added -.. -reduce-records => move runs to completed-runs.db -.. -restore-records => move runs from completed-runs.db to megatest.db - -*Branch*: This work is taking place on branch v1.65-reduce-records - -RFC M03: Automatic homehost migrations -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -*Purpose*: Automatically migrate homehost. - -*Method*: Check that there are no tests running, launched or remotehoststart in past ½ hour then if not on homehost migrate the db to current host - -*Design*: - -. Check that the system is quiescent, i.e. that there are no runs in flight or recently run -. Create a lock -. Migrate the /tmp cache db to the current host -. Update the .homehost file -. Remove the lock - -*Branch*: This work not yet started - -Architecture Refactor -~~~~~~~~~~~~~~~~~~~~~ - -Goals -^^^^^ - -. Reduce load on the file system. Sqlite3 files on network filesystem can be - a burden. [green]#[DONE]# -. Reduce number of servers and frequency of start/stop. This is mostly an - issue of clutter but also a reduction in "moving parts". [green]#[DONE]# -. Coalesce activities to a single home host where possible. Give the user - feedback that they have started the dashboard on a host other than the - home host. [green]#[DONE]# -. Reduce number of processes involved in managing running tests. - -Changes Needed -^^^^^^^^^^^^^^ - -. ACID compliant db will be on /tmp and synced to megatest.db with a five - second max delay. [green]#[DONE]# -. Read/writes to db for processes on homehost will go direct to /tmp - megatest.db file. [green]#[DONE]# -. Read/wites fron non-homehost processes will go through one server. Bulk - reads (e.g. for dashboard or list-runs) will be cached on the current host - in /tmp and synced from the home megatest.db in the testsuite area. [green]#[DONE]# -. Db syncs rely on the target db file timestame minus some margin. [green]#[DONE]# -. Since bulk reads do not use the server we can switch to simple RPC for the - network transport. [green]#[DONE]# -. Test running manager process extended to manage multiple running tests. - -Current Items -~~~~~~~~~~~~~ - -ww05 - migrate to inmem-db -^^^^^^^^^^^^^^^^^^^^^^^^^^ - -. Switch to inmem db with fast sync to on disk db's [green]#[DONE]# -. Server polls tasks table for next action -.. Task table used for tracking runner process [red]#[Replaced by mtutil]# -.. Task table used for jobs to run [red]#[Replaced by mtutil]# -.. Task table used for queueing runner actions (remove runs, - cleanRunExecute, etc) [red]#[Replaced by mtutil#] - - -// ww32 -// ~~~~ -// -// . Rerun step and or subsequent steps from gui -// . Refresh test area files from gui -// . Clean and re-run button -// . Clean up STATE and STATUS handling. -// .. Dashboard and Test control panel are reverse order - choose and fix -// .. Move seldom used states and status to drop down selector -// . Access test control panel when clicking on Run Summary tests -// . Feature: -generate-index-tree -// . Change specifing of state and status to use STATE1/STATUS1,STATE2/STATUS2 -// -// ww33 -// ~~~~ -// -// . http api available for use with Perl, Ruby etc. scripts -// . megatest.config setup entries for: -// .. run launching (e.g. /bin/sh %CMD% > /dev/null) -// .. browser "konqueror %FNAME% -// -// ww34 -// ~~~~ -// -// . Mark dependent tests for clean/rerun -rerun-downstream -// . On run start check for defunct tests in RUNNING, LAUNCHED or REMOTEHOSTSTART and correct or notify -// . Fix: refresh of gui sometimes fails on last item (race condition?) -// -// ww35 -// ~~~~ -// -// . refdb: Add export of csv, json and sexp -// . Convert to using call-with-environment-variables where possible. Should allow handling of parallel runs in same process. -// . Re-work text interface wizards. Several bugs on record. Possibly convert to gui based. -// . Add to testconfig requirements section; launchlimiter scriptname, calls scriptname to check if ok to launch test -// . Refactor Run Summary view, currently very clumsy -// . Add option to show steps in Run Summary view -// -// ww36 -// ~~~~ -// -// . Refactor guis for resizeablity -// . Add filters to Run Summary view and Run Control view -// . Add to megatest.config or testconfig; rerunok STATE/STATUS,STATE/STATUS... -// . Launch gates for diskspace; /path/one>1G,/path/two>200M,/tmp>5G,#{scheme *toppath*}>1G -// -// Bin List -// ~~~~~~~~ -// -// . Quality improvements -// .. Server stutters occasionally -// .. Large number of items or tests still has some issues. -// .. Code refactoring -// .. Replace remote process with true API using json (supports Web app also) -// . Streamline the gui -// .. Everything resizable -// .. Less clutter -// .. Tool tips -// .. Filters on Run Summary, Summary and Run Control panel -// .. Built in log viewer (partially implemented) -// .. Refactor the test control panel -// . Help and documentation -// .. Complete the user manual (I’ve been working on this lately). -// .. Online help in the gui -// . Streamlined install -// .. Deployed version (download a location independent ready to run binary bundle) -// .. Install Makefile (in progress, needed for Mike to install on VMs) -// .. Added option to compile IUP (needed for VMs) -// . Server side run launching -// . Support for re-running, cleaning etc. of individual steps (ezsteps makes this very easy to implement). -// . Launch process needs built in daemonizing (easy to do, just need to test it thoroughly). -// . Wizards for creating tests, regression areas (current ones are text only and limited). -// . Fully functional built in web service (currently you can browse runs but it is very simplistic). -// . Wildcards in runconfigs: e.g. [p1271/9/%/%] -// . Gui panels for editing megatest.config and runconfigs.config -// . Fully isolated tests (no use of NFS to see regression area files) -// . Windows version +// 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 . + +// Copyright 2006-2020, Matthew Welland. + +TODO / Road Map +--------------- + +Note: This road-map is a wish list and not a formal plan. Items are in +rough priority but are subject to change. Development is driven by +user requests, developer "itch" and bug reports. Please contact +matt@kiatoa.com with requests or bug reports. Requests from inside +Intel generally take priority. + +Dashboard and runs + +. Multi-area dashboard view + +Tests Support + +. Add variable $MT_RUNPATH = $MT_LINKTREE/$MT_TARGET/$MT_RUNNAME +. Improve [script], especially indent handling + +Scalability + +. Overflow database methodology - combine the best of the v1.63 + multi-db approach and the current db-in-tmp approach (currently + slowness can be seen when number of tests in a db goes over 50-100k, + with the overflow db it will be able to handle 1000's of runs with + 50-100k tests per run). High priority - goal is to complete this by + 20Q3. + +Mtutils/CI + +. Enable mtutil calls from dashboard (for remote control) +. Logs browser (esp. for surfacing mtutil related activities) +. Embed ftfplan for distributed automation, completed activities trigger QA runs which trigger deployment etc. +. Jenkins junit XML support [DONE] +. Add output flushing in teamcity support + +Build system + +. ./configure => ubuntu, sles11, sles12, rh7 [WIP] +. Switch to using simple runs query everywhere +. Add end_time to runs and add a rollup call that sets state, status and end_time + +Code refactoring/quality/performance + +. Switch to scsh-process pipeline management for job execution/control +. Use call-with-environment-variables where possible. + +Migration to inmem db and or overflow db + +. Re-work the dbstruct data structure? +.. [ run-id.db inmemdb last-mod last-read last-sync inuse ] + +Some ideas for Megatest 2.0 + +. Aggressive megatest.config and runconfig.config caching. +.. Cache the configs in $MT_RUNPATH +.. Following invocations of –run, -rerun* will calculate the new config but only overwrite the cached file IF changed +. If the cached file changes ALL existing tests go from COMPLETED -> STALE, I’m not sure what to do about RUNNING tests +. !VARS in runconfigs are not exported to the environment. They are accessed via rget as if the ! was not there. +. Per test copy commands (example is incomplete). +---------------- +[testcopy] +%/iind% unison SRC DEST +% cp –r SRC DEST +---------------- + +Add ability to move runs to other Areas (overlaps with overflow db system) + +. allow shrinking megatest.db data by moving runs to an alternate + Megatest area with same keys. +. add param -destination [area|path]. when specified runs are copied to new + area and removed from local db. +. the data move would involve these steps +.. copy the run data to destination area megatest.db +.. mark the run records as deleted, do not remove the run data on disk +. accessing the data would be by running dashboard in the satellite area +. future versions of Megatest dashboard should support displaying areas in a + merged way. +. some new controls would be supported in the config +.. [setup] => allow-runs [no|yes] <== used to disallow runs +.. [setup] => auto-migrate=[areaname|path] <== used to automatically + migrate data to a satellite area. + +Eliminate ties to homehost (part of overflow db system) + +. Server creates captain pkt +. Create a lock in the db +. Relinquish db when done + +Tasks - better management of run manager processes etc. + +. adjutant queries tasks table for next action [red]#[Migrate into mtutil]# +.. Task table used for tracking runner process [red]#[Replaced by mtutil]# +.. Task table used for jobs to run [red]#[Replaced by mtutil]# +.. Task table used for queueing runner actions (remove runs, + cleanRunExecute, etc) [red]#[Replaced by mtutil#] +. adjutant (server/task dispatch/execution manager) + +Stale propagation + + . Mark dependent tests for clean/rerun -rerun-downstream + . On run start check for defunct tests in RUNNING, LAUNCHED or REMOTEHOSTSTART and correct or notify + . Fix: refresh of gui sometimes fails on last item (race condition?) + +Bin list + + . Rerun step and or subsequent steps from gui [DONE?] + . Refresh test area files from gui + . Clean and re-run button + . Clean up STATE and STATUS handling. + .. Dashboard and Test control panel are reverse order - choose and fix + .. Move seldom used states and status to drop down selector + . Access test control panel when clicking on Run Summary tests + . Feature: -generate-index-tree + . Change specifing of state and status to use STATE1/STATUS1,STATE2/STATUS2 + + . rest api available for use with Perl, Ruby etc. scripts + . megatest.config setup entries for: + .. run launching (e.g. /bin/sh %CMD% > /dev/null) + .. browser "konqueror %FNAME% + + . refdb: Add export of csv, json and sexp + . Convert to using call-with-environment-variables where possible. Should allow handling of parallel runs in same process. + . Re-work text interface wizards. Several bugs on record. Possibly convert to gui based. + . Add to testconfig requirements section; launchlimiter scriptname, calls scriptname to check if ok to launch test + . Refactor Run Summary view, currently very clumsy + . Add option to show steps in Run Summary view + . Refactor guis for resizeablity + . Add filters to Run Summary view and Run Control view + . Add to megatest.config or testconfig; rerunok STATE/STATUS,STATE/STATUS... + . Launch gates for diskspace; /path/one>1G,/path/two>200M,/tmp>5G,#{scheme *toppath*}>1G + . Tool tips + . Filters on Run Summary, Summary and Run Control panel + . Built in log viewer (partially implemented) + . Refactor the test control panel + Help and documentation + . Complete the user manual (I’ve been working on this lately). + . Online help in the gui + Streamlined install + . Deployed or static build + . Added option to compile IUP (needed for VMs) + . Server side run launching + . Wizards for creating tests, regression areas (current ones are text only and limited). + . Fully functional built in web service (currently you can browse runs but it is very simplistic). + . Gui panels for editing megatest.config and runconfigs.config + . Fully isolated tests (no use of NFS to see regression area files) + . Windows version Index: launch.scm ================================================================== --- launch.scm +++ launch.scm @@ -911,11 +911,11 @@ (current-state (rmt:get-run-state run-id)) (current-status (rmt:get-run-status run-id))) ;;get-vars run-id to query metadata table to check if all completed. if all-test-launched = yes then only not-completed-cnt = 0 means everyting is completed if no entry found in the table do nothing (debug:print 0 *default-log-port* "rollup run state/status") (rmt:set-state-status-and-roll-up-run run-id current-state current-status) - + (runs:update-junit-test-reporter-xml run-id) (cond ((and all-test-launched (eq? not-completed-cnt 0) (equal? all-test-launched "yes" )) (debug:print 0 *default-log-port* "look for post hook.") (runs:run-post-hook run-id)) ((> running-cnt 3) Index: megatest-version.scm ================================================================== --- megatest-version.scm +++ megatest-version.scm @@ -18,6 +18,6 @@ ;; Always use two or four digit decimal ;; 1.01, 1.02...1.10,1.11,1.1101 ... 1.99,2.00.. (declare (unit megatest-version)) -(define megatest-version 1.6601) +(define megatest-version 1.6602) Index: megatest.scm ================================================================== --- megatest.scm +++ megatest.scm @@ -43,22 +43,24 @@ (declare (uses api)) (declare (uses tasks)) ;; only used for debugging. (declare (uses env)) (declare (uses diff-report)) (declare (uses commonmod)) +(declare (uses adjutant)) ;; (declare (uses ftail)) ;; (import ftail) -(import stml2 mutils commonmod) +(import stml2 mutils commonmod adjutant) ;; invoke the imports ;; (declare (uses mtargs.import)) ;; (declare (uses mtconfigf.import)) (declare (uses cookie.import)) (declare (uses stml2.import)) (declare (uses pkts.import)) (declare (uses commonmod.import)) +(declare (uses adjutant.import)) (define *db* #f) ;; this is only for the repl, do not use in general!!!! (include "common_records.scm") (include "key_records.scm") @@ -215,10 +217,12 @@ -update-meta : update the tests metadata for all tests -setvars VAR1=val1,VAR2=val2 : Add environment variables to a run NB// these are overwritten by values set in config files. -server -|hostname : start the server (reduces contention on megatest.db), use - to automatically figure out hostname + -adjutant C,M : start the server/adjutant with allocated cores C and Mem M (Gig), + use 0,0 to auto use full machine -transport http|rpc : use http or rpc for transport (default is http) -log logfile : send stdout and stderr to logfile -list-servers : list the servers -kill-servers : kill all servers -repl : start a repl (useful for extending megatest) @@ -330,10 +334,11 @@ "-contour" "-area-tag" "-area" "-run-tag" "-server" + "-adjutant" "-transport" "-port" "-extract-ods" "-pathmod" "-env2file" @@ -510,10 +515,11 @@ (let* ((no-watchdog-args '("-list-runs" "-testdata-csv" "-list-servers" "-server" + "-adjutant" "-list-disks" "-list-targets" "-show-runconfig" ;;"-list-db-targets" "-show-runconfig" @@ -903,10 +909,18 @@ (if (args:get-arg "-server") (let ((tl (launch:setup)) (transport-type (string->symbol (or (args:get-arg "-transport") "http")))) (server:launch 0 transport-type) (set! *didsomething* #t))) + +;; The adjutant is a bit different, it does NOT run (launch:setup) as it is not necessarily tied to +;; a specific Megatest area. Detail are being hashed out and this may change. +;; +(if (args:get-arg "-adjutant") + (begin + (adjutant-run) + (set! *didsomething* #t))) (if (or (args:get-arg "-list-servers") (args:get-arg "-kill-servers")) (let ((tl (launch:setup))) (if tl ;; all roads from here exit @@ -1691,10 +1705,69 @@ ;;====================================================================== ;; full run ;;====================================================================== + +(define (handle-run-requests target runname keys keyvals need-clean) + (if (or (args:get-arg "-kill-rerun") (args:get-arg "-rerun-clean")) ;; first set states/statuses correct + ;; For rerun-clean do we or do we not support the testpatt? + (let ((states (or (configf:lookup *configdat* "validvalues" "cleanrerun-states") + "KILLREQ,KILLED,UNKNOWN,INCOMPLETE,STUCK,NOT_STARTED")) + (statuses (or (configf:lookup *configdat* "validvalues" "cleanrerun-statuses") + "FAIL,INCOMPLETE,ABORT,CHECK,DEAD,PREQ_FAIL,PREQ_DISCARDED"))) + (hash-table-set! args:arg-hash "-preclean" #t) + (runs:operate-on 'set-state-status + target + (common:args-get-runname) ;; (or (args:get-arg "-runname")(args:get-arg ":runname")) + ;; "%" ;; (common:args-get-testpatt #f) ;; (args:get-arg "-testpatt") + (common:args-get-testpatt #f) ;; (args:get-arg "-testpatt") + state: states + ;; status: statuses + new-state-status: "NOT_STARTED,n/a") + (runs:clean-cache target runname *toppath*) + (runs:operate-on 'set-state-status + target + (common:args-get-runname) ;; (or (args:get-arg "-runname")(args:get-arg ":runname")) + ;; "%" ;; (common:args-get-testpatt #f) ;; (args:get-arg "-testpatt") + (common:args-get-testpatt #f) ;; (args:get-arg "-testpatt") + ;; state: states + status: statuses + new-state-status: "NOT_STARTED,n/a"))) + ;; RERUN ALL + (if (args:get-arg "-rerun-all") ;; first set states/statuses correct + (let* ((rconfig (full-runconfigs-read))) + (hash-table-set! args:arg-hash "-preclean" #t) + (runs:operate-on 'set-state-status + target + (common:args-get-runname) ;; (or (args:get-arg "-runname")(args:get-arg ":runname")) + (common:args-get-testpatt rconfig) ;; (args:get-arg "-testpatt") + state: #f + ;; status: statuses + new-state-status: "NOT_STARTED,n/a") + (runs:clean-cache target runname *toppath*) + (runs:operate-on 'set-state-status + target + (common:args-get-runname) ;; (or (args:get-arg "-runname")(args:get-arg ":runname")) + (common:args-get-testpatt rconfig) ;; (args:get-arg "-testpatt") + ;; state: states + status: #f + new-state-status: "NOT_STARTED,n/a"))) + (let* ((config-reruns (let ((x (configf:lookup *configdat* "setup" "reruns"))) + (if x (string->number x) #f))) + (rerun-cnt (if config-reruns + config-reruns + 1))) + + (runs:run-tests target + runname + #f ;; (common:args-get-testpatt #f) + ;; (or (args:get-arg "-testpatt") + ;; "%") + user + args:arg-hash + run-count: rerun-cnt))) ;; get lock in db for full run for this directory ;; for all tests with deps ;; walk tree of tests to find head tasks ;; add head tasks to task queue @@ -1714,72 +1787,39 @@ (args:get-arg "-rerun-clean") (args:get-arg "-rerun-all") (args:get-arg "-runtests") (args:get-arg "-kill-rerun")) (let ((need-clean (or (args:get-arg "-rerun-clean") - (args:get-arg "-rerun-all")))) + (args:get-arg "-rerun-all"))) + (orig-cmdline (string-intersperse (argv) " "))) (general-run-call "-runall" "run all tests" (lambda (target runname keys keyvals) - (if (or (args:get-arg "-kill-rerun") (args:get-arg "-rerun-clean")) ;; first set states/statuses correct - ;; For rerun-clean do we or do we not support the testpatt? - (let ((states (or (configf:lookup *configdat* "validvalues" "cleanrerun-states") - "KILLREQ,KILLED,UNKNOWN,INCOMPLETE,STUCK,NOT_STARTED")) - (statuses (or (configf:lookup *configdat* "validvalues" "cleanrerun-statuses") - "FAIL,INCOMPLETE,ABORT,CHECK,DEAD,PREQ_FAIL,PREQ_DISCARDED"))) - (hash-table-set! args:arg-hash "-preclean" #t) - (runs:operate-on 'set-state-status - target - (common:args-get-runname) ;; (or (args:get-arg "-runname")(args:get-arg ":runname")) - ;; "%" ;; (common:args-get-testpatt #f) ;; (args:get-arg "-testpatt") - (common:args-get-testpatt #f) ;; (args:get-arg "-testpatt") - state: states - ;; status: statuses - new-state-status: "NOT_STARTED,n/a") - (runs:clean-cache target runname *toppath*) - (runs:operate-on 'set-state-status - target - (common:args-get-runname) ;; (or (args:get-arg "-runname")(args:get-arg ":runname")) - ;; "%" ;; (common:args-get-testpatt #f) ;; (args:get-arg "-testpatt") - (common:args-get-testpatt #f) ;; (args:get-arg "-testpatt") - ;; state: states - status: statuses - new-state-status: "NOT_STARTED,n/a"))) - ;; RERUN ALL - (if (args:get-arg "-rerun-all") ;; first set states/statuses correct - (let* ((rconfig (full-runconfigs-read))) - (hash-table-set! args:arg-hash "-preclean" #t) - (runs:operate-on 'set-state-status - target - (common:args-get-runname) ;; (or (args:get-arg "-runname")(args:get-arg ":runname")) - (common:args-get-testpatt rconfig) ;; (args:get-arg "-testpatt") - state: #f - ;; status: statuses - new-state-status: "NOT_STARTED,n/a") - (runs:clean-cache target runname *toppath*) - (runs:operate-on 'set-state-status - target - (common:args-get-runname) ;; (or (args:get-arg "-runname")(args:get-arg ":runname")) - (common:args-get-testpatt rconfig) ;; (args:get-arg "-testpatt") - ;; state: states - status: #f - new-state-status: "NOT_STARTED,n/a"))) - (let* ((config-reruns (let ((x (configf:lookup *configdat* "setup" "reruns"))) - (if x (string->number x) #f))) - (rerun-cnt (if config-reruns - config-reruns - 1))) - - (runs:run-tests target - runname - #f ;; (common:args-get-testpatt #f) - ;; (or (args:get-arg "-testpatt") - ;; "%") - user - args:arg-hash - run-count: rerun-cnt)))))) + (if (or (string-search "%" target) + (string-search "%" runname)) ;; we are being asked to re-run multiple runs + (let* ((run-specs (rmt:simple-get-runs runname #f #f target #f))) ;; list of simple-run records + (debug:print-info 0 *default-log-port* "Pattern supplied for target or runname with " + (length run-specs) " matches round. Running each in turn.") + (if (null? run-specs) + (debug:print 0 *default-log-port* "WARNING: No runs match target " target " and runname " runname)) + (for-each (lambda (spec) + (let* ((precmd (if (args:get-arg "-precmd")(conc (args:get-arg "-precmd") " ") "")) + (newcmdline (conc + precmd + (string-substitute + (conc "target " target) + (conc "target " (simple-run-target spec)) + (string-substitute + (conc "runname " runname) + (conc "runname " (simple-run-runname spec)) + orig-cmdline))))) + (debug:print 0 *default-log-port* "ORIG: " orig-cmdline) + (debug:print 0 *default-log-port* "NEW: " newcmdline) + (system newcmdline))) + run-specs)) + (handle-run-requests target runname keys keyvals need-clean)))))) ;;====================================================================== ;; run one test ;;====================================================================== Index: runs.scm ================================================================== --- runs.scm +++ runs.scm @@ -16,11 +16,11 @@ ;; along with Megatest. If not, see . ;; 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) + posix-extras directory-utils pathname-expand typed-records format sxml-serializer sxml-modifications) (declare (unit runs)) (declare (uses db)) (declare (uses common)) (declare (uses items)) @@ -2085,10 +2085,19 @@ sorted))) ;; (print "Sorted: " (map simple-run-event_time sorted)) ;; (print "Remove: " (map simple-run-event_time to-remove)))) (hash-table-keys runs-ht)) runs-ht)) + +(define (remove-last-path-directory path-in) + (let* ((dparts (string-split path-in "/")) + (path-out (conc "/" (string-intersperse (take dparts (- (length dparts) 1)) "/"))) + ) + path-out + ) +) + ;; (define (runs:remove-all-but-last-n-runs-per-target target-patts runpatt num-to-keep) ;; (let ((data (runs:get-all-but-most-recent-n-per-target target-patts runpatt num-to-keep))) ;; (for-each ;; (lambda (target) @@ -2154,10 +2163,12 @@ (tests (if (not (equal? run-state "locked")) (proc-get-tests run-id) '())) (lasttpath "/does/not/exist/I/hope") (lastrealpath "/does/not/exist/I/hope") + ;; there may be a number of different disks used in the same run. + (run-paths-hash (make-hash-table)) (worker-thread #f)) (debug:print-info 4 *default-log-port* "runs:operate-on run=" run ", header=" header) (if (not (null? tests)) (begin (case action @@ -2336,18 +2347,34 @@ ;; NOTE: This is suboptimal as the testdata will be used later and the state/status may have changed ... (if (null? tal) (loop new-test-dat tal) (loop (car tal)(append tal (list new-test-dat))))) (begin - (set! lasttpath (db:test-get-rundir new-test-dat)) ;; remember this path for run removal - (if (file-exists? lasttpath) - (set! lastrealpath (resolve-pathname lasttpath)) - (set! lastrealpath lasttpath)) - (runs:remove-test-directory new-test-dat mode) ;; 'remove-all) - - (if (not (null? tal)) - (loop (car tal)(cdr tal))))))) + (let ((rundir (db:test-get-rundir new-test-dat))) + (if (and (not (string= rundir "/tmp/badname")) + (file-exists? rundir) + (substring-index run-name rundir) + (substring-index target rundir) + ) + (begin + (set! lasttpath (db:test-get-rundir new-test-dat)) ;; remember this path for run removal + (set! lastrealpath (remove-last-path-directory (resolve-pathname lasttpath))) + (hash-table-set! run-paths-hash lastrealpath 1) + (runs:remove-test-directory new-test-dat mode) ;; 'remove-all) + ) + (begin + (debug:print 2 *default-log-port* "Not removing directory " rundir " because either it doesn't exist or has a bad name") + (debug:print 2 *default-log-port* "Is /tmp/badname: " (string= rundir "/tmp/badname")) + (debug:print 2 *default-log-port* "Exists: " (file-exists? rundir)) + (debug:print 2 *default-log-port* "Has run-name: " (substring-index run-name rundir)) + (debug:print 2 *default-log-port* "Has target: " (substring-index target rundir)) + ) + ) + ) + + (if (not (null? tal)) + (loop (car tal)(cdr tal))))))) (rmt:update-run-stats run-id (rmt:get-raw-run-stats run-id))) ((kill-runs) ;; RUNNING -> KILLREQ ;; LAUNCHED,RUNNING,REMOTEHOSTSTART -> NOT STARTED (cond @@ -2419,31 +2446,32 @@ ;; remove the run if zero tests remain (if (eq? action 'remove-runs) (let* ((run-id (db:get-value-by-header run header "id")) ;; NB// masks run-id from above? (remtests (mt:get-tests-for-run run-id #f '("DELETED") '("n/a") not-in: #t))) (if (null? remtests) ;; no more tests remaining - ;; Remove the last dir from the path. - ;; And same for the link-resolved path - (let* ((dparts (string-split lasttpath "/")) - (linkspath (conc "/" (string-intersperse (take dparts (- (length dparts) 1)) "/"))) - (real-dparts (string-split lastrealpath "/")) - (realpath (conc "/" (string-intersperse (take real-dparts (- (length real-dparts) 1)) "/"))) - ) - - (debug:print 1 *default-log-port* "Removing run: " linkspath) - (if (not keep-records) - (begin - (debug:print 1 *default-log-port* "Removing DB records for the run.") - (rmt:delete-run run-id) - (rmt:delete-old-deleted-test-records)) - ) - (debug:print 1 *default-log-port* "Recursively removing links dir " linkspath) - (runs:recursive-delete-with-error-msg linkspath) - - (debug:print 1 *default-log-port* "Recursively removing real dir " realpath) - (runs:recursive-delete-with-error-msg realpath) - + (let* ((linkspath (remove-last-path-directory lasttpath)) + (runpaths (hash-table-keys run-paths-hash)) + ) + + (debug:print 2 *default-log-port* "run-paths-hash: " (hash-table-keys run-paths-hash)) + + (debug:print 1 *default-log-port* "Removing target " target "run: " run-name) + (if (not keep-records) + (begin + (debug:print 1 *default-log-port* "Removing DB records for the run.") + (rmt:delete-run run-id) + (rmt:delete-old-deleted-test-records)) + ) + (debug:print 1 *default-log-port* "Recursively removing links dir " linkspath) + (runs:recursive-delete-with-error-msg linkspath) + + (for-each (lambda(runpath) + (debug:print 1 *default-log-port* "Recursively removing runs dir " runpath) + (runs:recursive-delete-with-error-msg runpath) + ) + runpaths + ) ))))) )) runs) ;; special case - archive get (if (equal? (args:get-arg "-archive") "get") @@ -2699,10 +2727,104 @@ (conc "INSERT OR REPLACE INTO test_data (test_id,category,variable,value,expected,tol,units,comment) " "SELECT " (db:test-get-id new-testdat) ",category,variable,value,expected,tol,units,comment FROM test_data WHERE test_id=?;") (db:test-get-id testdat)))) )) prev-tests))) + +(define doc-template + '(*TOP* + (*PI* xml "version='1.0'") + (testsuite))) + +(define (runs:update-junit-test-reporter-xml run-id) + (let* ( + (junit-test-reporter (configf:lookup *configdat* "runs" "junit-test-reporter-xml")) + (junit-test-report-dir (configf:lookup *configdat* "runs" "junit-test-report-dir")) + (xml-dir (if (and junit-test-reporter (equal? junit-test-reporter "yes" )) + (if junit-test-report-dir + junit-test-report-dir + (conc (getenv "MT_LINKTREE") "/" (getenv "MT_TARGET") "/" (getenv "MT_RUNNAME"))) + #f)) + (xml-ts-name (if xml-dir + (conc (getenv "MT_TESTSUITENAME")"."(string-translate (getenv "MT_TARGET") "/" ".") "." (getenv "MT_RUNNAME")) + #f)) + (keyname (if xml-ts-name + (common:get-signature xml-ts-name) + #f)) + (xml-path (if xml-dir + (conc xml-dir "/" keyname ".xml") + #f)) + + (test-data (if xml-dir + (rmt:get-tests-for-run run-id "%" '() '() ;; run-id testpatt states statuses + #f #f ;; offset limit + #f ;; not-in + #f ;; sort-by + #f ;; sort-order + #f ;; get full data (not 'shortlist) + 0 ;; (runs:gendat-inc-results-last-update *runs:general-data*) ;; last update time + #f) + '())) + (tests-count (if xml-dir (length test-data) #f))) + (if (and junit-test-reporter (equal? junit-test-reporter "yes" )) + (begin + ;((sxml-modify! `("testsuite" insert-into (@ (name ,xml-ts-name) (tests ,tests-count)))) doc) + + (let loop ((test (car test-data)) + (tail (cdr test-data)) + (doc doc-template) + (fail-cnt 0) + (error-cnt 0)) + (let* ((test-name (vector-ref test 2)) + (test-itempath (vector-ref test 11)) + (tc-name (conc test-name (if (and test-itempath (not (equal? test-itempath ""))) (conc "." (string-translate test-itempath "/" "." )) ""))) + (test-state (vector-ref test 3)) + (comment (vector-ref test 14)) + (test-status (vector-ref test 4)) + (exc-msg (conc "No bucket for State " test-state " Status " test-status)) + (new-doc (cond + ((member test-state (list "RUNNING" )) + ((sxml-modify `("testsuite" insert-into (testcase (@ (name ,tc-name)) (inProgress (@ (type "inProgress")))))) doc)) + ((member test-state (list "LAUNCHED" "REMOTEHOSTSTART" "NOT_STARTED")) + ((sxml-modify `("testsuite" insert-into (testcase (@ (name ,tc-name)) (inProgress (@ (type "inQueue")))))) doc)) + ((member test-status (list "PASS" "WARN" "WAIVED")) + ((sxml-modify `("testsuite" insert-into (testcase (@ (name ,tc-name))))) doc)) + ((member test-status (list "FAIL" "CHECK")) + ((sxml-modify `("testsuite" insert-into (testcase (@ (name ,tc-name)) (failure (@ (message ,comment) (type "failure")))))) doc)) + ((member test-status (list "DEAD" "KILLED" "ABORT" "PREQ_FAIL" "PREQ_DISCARDED")) + ((sxml-modify `("testsuite" insert-into (testcase (@ (name ,tc-name)) (failure (@ (message ,comment) (type "error")))))) doc)) + ((member test-status (list "SKIP")) + ((sxml-modify `("testsuite" insert-into (testcase (@ (name ,tc-name)) (skipped (@ (type "skipped")))))) doc)) + (else + (debug:print 0 *default-log-port* (conc "What do I do with State " test-state " Status " test-status)) + ((sxml-modify `("testsuite" insert-into (testcase (@ (name ,tc-name)) (failure (@ (message ,exc-msg) (type "error")))))) doc)))) + (new-error-cnt (if (member test-status (list "DEAD" "KILLED" "ABORT" "PREQ_FAIL" "PREQ_DISCARDED")) + (+ error-cnt 1) + error-cnt)) + (new-fail-cnt (if (member test-status (list "FAIL" "CHECK")) + (+ fail-cnt 1) + fail-cnt))) + (if (null? tail) + (let* ((final-doc ((sxml-modify `("testsuite" insert-into (@ (name ,xml-ts-name) (tests ,tests-count) (errors ,error-cnt) (failures ,fail-cnt)))) new-doc))) + (debug:print 0 *default-log-port* "modify attrib error=" error-cnt " fail= " fail-cnt) + (handle-exceptions + exn + (let* ((msg ((condition-property-accessor 'exn 'message) exn))) + (debug:print 0 *default-log-port* (conc "WARNING: Failed to update file" xml-path". Message:" msg))) + + (if (not (file-exists? xml-dir)) + (create-directory xml-dir #t)) + (if (not (rmt:no-sync-get/default keyname #f)) + (begin + (rmt:no-sync-set keyname "on") + (debug:print 0 *default-log-port* "creating xml at " xml-path) + (with-output-to-file xml-path + (lambda () + (print (sxml-serializer#serialize-sxml final-doc ns-prefixes: (list (cons 'gnm "http://foo")))))) + (rmt:no-sync-del! keyname)) + (debug:print 0 *default-log-port* "Could not get the lock. Skip writing the xml file.")))) + (loop (car tail) (cdr tail) new-doc new-fail-cnt new-error-cnt)))))))) ;; clean cache files (define (runs:clean-cache target runname toppath) (if target