Changes In Branch 1.65-modularization Excluding Merge-Ins
This is equivalent to a diff from 0a8c497528 to 186af26419
2018-08-12
| ||
17:54 | Clarified help on show in mtutils. Adjusted targets in gentargets.sh to match what is in ext-tests. Fixed endless loop in runs.scm when there is a subrun that cannot be removed or fails to remove. check-in: e669693ecf user: matt tags: v1.65 | |
15:55 | A different try at modularization Leaf check-in: 186af26419 user: matt tags: 1.65-modularization | |
2018-08-10
| ||
17:13 | removed debug comment check-in: 0a8c497528 user: pjhatwal tags: v1.65 | |
16:31 | Merged mtutil changes into main 1.65 branch check-in: 058bef1510 user: jmoon18 tags: v1.65 | |
Modified Makefile from [12a7839170] to [9d4ed5c6a8].
︙ | ︙ | |||
154 155 156 157 158 159 160 161 162 163 164 165 166 167 | tests.o tasks.o dashboard-tasks.o : task_records.scm runs.o : test_records.scm megatest.o : megatest-fossil-hash.scm rmt.scm client.scm common.scm configf.scm dashboard-guimonitor.scm dashboard-tests.scm dashboard.scm db.scm dcommon.scm ezsteps.scm fs-transport.scm http-transport.scm index-tree.scm items.scm keys.scm launch.scm megatest.scm monitor.scm mt.scm newdashboard.scm runconfig.scm runs.scm server.scm tdb.scm tests.scm tree.scm : common_records.scm common_records.scm : altdb.scm vg.o dashboard.o : vg_records.scm dcommon.o : run_records.scm # Temporary while transitioning to new routine # runs.o : run-tests-queue-classic.scm run-tests-queue-new.scm megatest-fossil-hash.scm : $(SRCFILES) megatest.scm *_records.scm echo "(define megatest-fossil-hash \"$(MTESTHASH)\")" > megatest-fossil-hash.new if ! diff -q megatest-fossil-hash.new megatest-fossil-hash.scm ; then echo copying .new to .scm;cp -f megatest-fossil-hash.new megatest-fossil-hash.scm;fi | > | 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 | tests.o tasks.o dashboard-tasks.o : task_records.scm runs.o : test_records.scm megatest.o : megatest-fossil-hash.scm rmt.scm client.scm common.scm configf.scm dashboard-guimonitor.scm dashboard-tests.scm dashboard.scm db.scm dcommon.scm ezsteps.scm fs-transport.scm http-transport.scm index-tree.scm items.scm keys.scm launch.scm megatest.scm monitor.scm mt.scm newdashboard.scm runconfig.scm runs.scm server.scm tdb.scm tests.scm tree.scm : common_records.scm common_records.scm : altdb.scm vg.o dashboard.o : vg_records.scm dcommon.o : run_records.scm # Temporary while transitioning to new routine # runs.o : run-tests-queue-classic.scm run-tests-queue-new.scm megatest-fossil-hash.scm : $(SRCFILES) megatest.scm *_records.scm echo "(define megatest-fossil-hash \"$(MTESTHASH)\")" > megatest-fossil-hash.new if ! diff -q megatest-fossil-hash.new megatest-fossil-hash.scm ; then echo copying .new to .scm;cp -f megatest-fossil-hash.new megatest-fossil-hash.scm;fi |
︙ | ︙ |
Modified common.scm from [5eccfcf84f] to [244c8fd99d].
︙ | ︙ | |||
14 15 16 17 18 19 20 21 22 23 24 | ;; 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/>. ;;====================================================================== (use srfi-1 data-structures posix regex-case (prefix base64 base64:) format dot-locking csv-xml z3 ;; sql-de-lite hostinfo md5 message-digest typed-records directory-utils stack matchable regex posix (srfi 18) extras ;; tcp | > > > > > > > > > > > | > < < > > | 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 47 48 49 50 51 52 | ;; 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)) ;;====================================================================== ;; MODULE STARTS HERE ;;====================================================================== (module common * (import chicken scheme data-structures extras srfi-13 ports ) (use srfi-1 data-structures posix regex-case (prefix base64 base64:) format dot-locking csv-xml z3 ;; sql-de-lite hostinfo md5 message-digest typed-records directory-utils stack matchable regex posix (srfi 18) extras ;; tcp nanomsg (prefix sqlite3 sqlite3:) pkts (prefix dbi dbi:) srfi-69 ) (include "common_records.scm") (require-library stml) ;; (import stml) ;; (require-library margs) ;; (include "margs.scm") ;; (define old-exit exit) ;; ;; (define (exit . code) |
︙ | ︙ | |||
291 292 293 294 295 296 297 | (define (common:get-full-version) (conc megatest-version "-" megatest-fossil-hash)) (define (common:version-signature) (conc megatest-version "-" (substring megatest-fossil-hash 0 4))) | < < < < < < < < | 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 | (define (common:get-full-version) (conc megatest-version "-" megatest-fossil-hash)) (define (common:version-signature) (conc megatest-version "-" (substring megatest-fossil-hash 0 4))) (define (common:get-last-run-version-number) (string->number (substring (common:get-last-run-version) 0 6))) ;; postive number if megatest version > db version ;; negative number if megatest version < db version (define (common:version-db-delta) (- megatest-version (common:get-last-run-version-number))) (define (common:version-changed?) (not (equal? (common:get-last-run-version) |
︙ | ︙ | |||
798 799 800 801 802 803 804 | (else (debug:print-info 13 *default-log-port* "loading writable-watchdog.") (server:writable-watchdog dbstruct))) (debug:print-info 13 *default-log-port* "watchdog done.")) (debug:print-info 13 *default-log-port* "no need for watchdog on non-homehost")))) | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 802 803 804 805 806 807 808 809 810 811 812 813 814 815 | (else (debug:print-info 13 *default-log-port* "loading writable-watchdog.") (server:writable-watchdog dbstruct))) (debug:print-info 13 *default-log-port* "watchdog done.")) (debug:print-info 13 *default-log-port* "no need for watchdog on non-homehost")))) (define (std-signal-handler signum) ;; (signal-mask! signum) (set! *time-to-exit* #t) ;;(debug:print-info 13 *default-log-port* "got signal "signum) (debug:print-error 0 *default-log-port* "Received signal " signum " aaa exiting promptly") ;; (std-exit-procedure) ;; shouldn't need this since we are exiting and it will be called anyway (exit)) |
︙ | ︙ | |||
1599 1600 1601 1602 1603 1604 1605 | ;; (print "NO MATCH: " hed) (loop (car tal)(cdr tal) loads proc-num phys-num core-num))))))))))) (define (common:unix-ping hostname) (let ((res (system (conc "ping -c 1 " hostname " > /dev/null")))) (eq? res 0))) | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 1556 1557 1558 1559 1560 1561 1562 1563 1564 1565 1566 1567 1568 1569 1570 1571 1572 1573 1574 1575 1576 1577 1578 1579 1580 1581 1582 1583 1584 1585 1586 1587 1588 1589 | ;; (print "NO MATCH: " hed) (loop (car tal)(cdr tal) loads proc-num phys-num core-num))))))))))) (define (common:unix-ping hostname) (let ((res (system (conc "ping -c 1 " hostname " > /dev/null")))) (eq? res 0))) ;; for reasons I don't understand multiple calls to real-path in parallel threads ;; must be protected by mutexes ;; (define (common:real-path inpath) ;; (process:cmd-run-with-stderr->list "readlink" "-f" inpath)) ;; cmd . params) ;; (let-values ;; (((inp oup pid) (process "readlink" (list "-f" inpath)))) ;; (with-input-from-port inp ;; (let loop ((inl (read-line)) ;; (res #f)) ;; (print "inl=" inl) ;; (if (eof-object? inl) ;; (begin ;; (close-input-port inp) ;; (close-output-port oup) ;; ;; (process-wait pid) ;; res) ;; (loop (read-line) inl)))))) (with-input-from-pipe (conc "readlink -f " inpath) read-line)) ;; convert a spec string to a list of vectors #( rx action rx-string ) (define (common:spec-string->list-of-specs spec-string actions) (let ((spec-strings (string-split-fields "\\s*;\\s*" spec-string #:infix)) (actions-regex (regexp (conc "^(.*)\\s+(" (string-intersperse (map conc actions) "|") ")")))) (filter (lambda (x) x) (map (lambda (s) |
︙ | ︙ | |||
2097 2098 2099 2100 2101 2102 2103 | (proc (proc))) (hash-table-for-each vars (lambda (var val) (setenv var val))) vars)) | < < < < < < < < < < < < | 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 | (proc (proc))) (hash-table-for-each vars (lambda (var val) (setenv var val))) vars)) ;;====================================================================== ;; T I M E A N D D A T E ;;====================================================================== ;; Convert strings like "5s 2h 3m" => 60x60x2 + 3x60 + 5 (define (common:hms-string->seconds tstr) (let ((parts (string-split-fields "\\w+" tstr)) |
︙ | ︙ | |||
2421 2422 2423 2424 2425 2426 2427 | (string-intersperse (map (lambda (x) (number->string x 16)) (map string->number (string-split instr))) "/")) | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 2079 2080 2081 2082 2083 2084 2085 2086 2087 2088 2089 2090 2091 2092 | (string-intersperse (map (lambda (x) (number->string x 16)) (map string->number (string-split instr))) "/")) ;;====================================================================== ;; ;;====================================================================== (define (common:in-running-test?) (and (args:get-arg "-execute") (get-environment-variable "MT_CMDINFO"))) |
︙ | ︙ | |||
2544 2545 2546 2547 2548 2549 2550 2551 | ;; ;; get registered dashboards ;; ;; ;; (define (mddb:get-dashboards) ;; (let ((db (mddb:open-db))) ;; (query fetch-column ;; (sql db "SELECT ipaddr || ':' || portnum FROM dashboards;")))) ;;====================================================================== | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | | 2169 2170 2171 2172 2173 2174 2175 2176 2177 2178 2179 2180 2181 2182 2183 2184 2185 2186 2187 2188 2189 | ;; ;; get registered dashboards ;; ;; ;; (define (mddb:get-dashboards) ;; (let ((db (mddb:open-db))) ;; (query fetch-column ;; (sql db "SELECT ipaddr || ':' || portnum FROM dashboards;")))) ;;====================================================================== ;; NMSG AND NEW API ;;====================================================================== ;; nm based server experiment, keep around for now. ;; #;(define (nm:start-server dbconn #!key (given-host-name #f)) (let* ((srvdat (start-raw-server given-host-name: given-host-name)) (host-name (srvdat-host srvdat)) (soc (srvdat-soc srvdat))) ;; start the queue processor (save for second round of development) ;; (thread-start! (make-thread! (lambda ()(queue-processor dbconn) "Queue processor"))) |
︙ | ︙ | |||
2929 2930 2931 2932 2933 2934 2935 | (if thread (handle-exceptions exn #t ;; just ignore it, it might have died in the meantime so joining it will throw an exception (thread-join! thread)) ))) (hash-table-keys *common:thread-punchlist*))) | > > | 2480 2481 2482 2483 2484 2485 2486 2487 2488 | (if thread (handle-exceptions exn #t ;; just ignore it, it might have died in the meantime so joining it will throw an exception (thread-join! thread)) ))) (hash-table-keys *common:thread-punchlist*))) ) |
Modified dashboard-tests.scm from [2af1eb577e] to [dc334b608b].
︙ | ︙ | |||
598 599 600 601 602 603 604 | (let* ((cmd (iup:attribute command-text-box "VALUE"))) (common:run-a-command cmd)))) (command-text-box (iup:textbox #:expand "HORIZONTAL" #:font "Courier New, -10" #:action (lambda (obj cnum val) ;; (print "cnum=" cnum) | | | 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 | (let* ((cmd (iup:attribute command-text-box "VALUE"))) (common:run-a-command cmd)))) (command-text-box (iup:textbox #:expand "HORIZONTAL" #:font "Courier New, -10" #:action (lambda (obj cnum val) ;; (print "cnum=" cnum) (if (eq? cnum 13) ;; carriage return? (command-prox obj))) )) (command-launch-button (iup:button "Execute!" #:action (lambda (x) (command-proc command-text-box)))) ;; (lambda (x) ;; (let* ((cmd (iup:attribute command-text-box "VALUE")) ;; (fullcmd (conc (dtests:get-pre-command) |
︙ | ︙ |
Modified db.scm from [f030aee63b] to [64e766fdd0].
|
| | | 1 2 3 4 5 6 7 8 | ;;====================================================================== ;; Copyright 2006-2016, 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 |
︙ | ︙ | |||
19 20 21 22 23 24 25 | ;;====================================================================== ;;====================================================================== ;; Database access ;;====================================================================== ;; dbstruct vector containing all the relevant dbs like main.db, megatest.db, run.db etc | < < < < < < > > > > > > > > > > > > | 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 47 48 49 50 51 | ;;====================================================================== ;;====================================================================== ;; Database access ;;====================================================================== ;; dbstruct vector containing all the relevant dbs like main.db, megatest.db, run.db etc (declare (unit db)) (declare (uses common)) (declare (uses keys)) (declare (uses ods)) (declare (uses client)) (declare (uses mt)) (module db * (import chicken scheme data-structures extras srfi-13 ports) (import common ods) (use (srfi 18) extras tcp stack) (use sqlite3 srfi-1 posix regex regex-case srfi-69 csv-xml s11n md5 message-digest base64 format dot-locking z3 typed-records matchable) (import (prefix sqlite3 sqlite3:)) (import (prefix base64 base64:)) (include "common_records.scm") (include "db_records.scm") (include "key_records.scm") (include "run_records.scm") (define *rundb-mutex* (make-mutex)) ;; prevent problems opening/closing rundb's (define *number-of-writes* 0) |
︙ | ︙ | |||
4616 4617 4618 4619 4620 4621 4622 | ;; brutal clean up (stack-push! (dbr:dbstruct-dbstack dbstruct) dbdat) (system "rm -rf tempdir"))) ;; (db:extract-ods-file db "outputfile.ods" '(("sysname" "%")("fsname" "%")("datapath" "%")) "%") | > | 4622 4623 4624 4625 4626 4627 4628 4629 | ;; brutal clean up (stack-push! (dbr:dbstruct-dbstack dbstruct) dbdat) (system "rm -rf tempdir"))) ;; (db:extract-ods-file db "outputfile.ods" '(("sysname" "%")("fsname" "%")("datapath" "%")) "%") ) |
Modified launch.scm from [a65f4f4d22] to [2792624ba1].
︙ | ︙ | |||
1404 1405 1406 1407 1408 1409 1410 | (exe (pathname-strip-directory lm))) (conc (if dir (conc dir "/") "") (case (string->symbol exe) ((dboard) "../megatest") ((mtest) "../megatest") ((dashboard) "megatest") (else exe))))) | | | 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 | (exe (pathname-strip-directory lm))) (conc (if dir (conc dir "/") "") (case (string->symbol exe) ((dboard) "../megatest") ((mtest) "../megatest") ((dashboard) "megatest") (else exe))))) (launcher (launch:get-launcher *configdat* test-name item-path)) ;; (config-lookup *configdat* "jobtools" "launcher")) (test-sig (conc (common:get-testsuite-name) ":" test-name ":" item-path)) ;; (item-list->path itemdat))) ;; test-path is the full path including the item-path (work-area #f) (toptest-work-area #f) ;; for iterated tests the top test contains data relevant for all (diskpath #f) (cmdparms #f) (fullcmd #f) ;; (define a (with-output-to-string (lambda ()(write x)))) (mt-bindir-path #f) |
︙ | ︙ | |||
1584 1585 1586 1587 1588 1589 1590 | (read-symbolic-link (conc "/proc/" pid "/cwd")) #f))) ;; now wait on that process if all is correct ;; periodically update the db with runtime ;; when the process exits look at the db, if still RUNNING after 10 seconds set ;; state/status appropriately (process-wait pid))) | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1584 1585 1586 1587 1588 1589 1590 1591 1592 1593 1594 1595 1596 1597 1598 1599 1600 1601 1602 1603 1604 1605 1606 1607 1608 1609 1610 1611 1612 1613 1614 1615 1616 1617 1618 1619 1620 1621 1622 1623 1624 1625 1626 1627 1628 1629 1630 1631 1632 1633 1634 1635 1636 1637 1638 1639 1640 1641 1642 1643 1644 1645 1646 1647 1648 1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 | (read-symbolic-link (conc "/proc/" pid "/cwd")) #f))) ;; now wait on that process if all is correct ;; periodically update the db with runtime ;; when the process exits look at the db, if still RUNNING after 10 seconds set ;; state/status appropriately (process-wait pid))) ;;====================================================================== ;; T E S T L A U N C H I N G P E R I T E M W I T H H O S T T Y P E S ;;====================================================================== ;; ;; [hosts] ;; arm cubie01 cubie02 ;; x86_64 zeus xena myth01 ;; allhosts #{g hosts arm} #{g hosts x86_64} ;; ;; [host-types] ;; general #MTLOWESTLOAD #{g hosts allhosts} ;; arm #MTLOWESTLOAD #{g hosts arm} ;; nbgeneral nbjob run JOBCOMMAND -log $MT_LINKTREE/$MT_TARGET/$MT_RUNNAME.$MT_TESTNAME-$MT_ITEM_PATH.lgo ;; ;; [host-rules] ;; # maxnload => max normalized load ;; # maxnjobs => max jobs per cpu ;; # maxjobrate => max jobs per second ;; general maxnload=1.1; maxnjobs=1.2; maxjobrate=0.1 ;; ;; [launchers] ;; envsetup general ;; xor/%/n 4C16G ;; % nbgeneral ;; ;; [jobtools] ;; # if defined and not "no" flexi-launcher will bypass "launcher" unless no match. ;; flexi-launcher yes ;; launcher nbfake ;; (define (launch:get-launcher configdat testname itempath) (let ((fallback-launcher (configf:lookup configdat "jobtools" "launcher"))) (if (and (configf:lookup configdat "jobtools" "flexi-launcher") ;; overrides launcher (not (equal? (configf:lookup configdat "jobtools" "flexi-launcher") "no"))) (let* ((launchers (hash-table-ref/default configdat "launchers" '()))) (if (null? launchers) fallback-launcher (let loop ((hed (car launchers)) (tal (cdr launchers))) (let ((patt (car hed)) (host-type (cadr hed))) (if (tests:match patt testname itempath) (begin (debug:print-info 2 *default-log-port* "Have flexi-launcher match for " testname "/" itempath " = " host-type) (let ((launcher (configf:lookup configdat "host-types" host-type))) (if launcher (let* ((launcher-parts (string-split launcher)) (launcher-exe (car launcher-parts))) (if (equal? launcher-exe "#MTLOWESTLOAD") ;; this is our special case, we will find the lowest load and craft a nbfake commandline (let host-loop ((targ-host (common:get-least-loaded-host (cdr launcher-parts) host-type configdat)) (count 100)) (if targ-host (conc "remrun " targ-host) (if (> count 0) (begin (debug:print 0 *default-log-port* "INFO: Waiting for a host for host-type " host-type) (thread-sleep! (- 101 count)) (host-loop (common:get-least-loaded-host (cdr launcher-parts) host-type configdat) (- count 1))) (begin (debug:print 0 *default-log-port* "FATAL: Failed to find a host from #MTLOWESTLOAD for host-type " host-type) (exit))))) launcher)) (begin (debug:print-info 0 *default-log-port* "WARNING: no launcher found for host-type " host-type) (if (null? tal) fallback-launcher (loop (car tal)(cdr tal))))))) ;; no match, try again (if (null? tal) fallback-launcher (loop (car tal)(cdr tal)))))))) fallback-launcher))) |
Modified ods.scm from [42e94b826f] to [d9d1269dce].
︙ | ︙ | |||
12 13 14 15 16 17 18 | ;; 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/>. ;; | < > > > > > > > | 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 | ;; 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 ods)) (declare (uses common)) (module ods * (import chicken scheme data-structures extras srfi-13 ports) (use csv-xml regex) (define ods:dirs '("Configurations2" "Configurations2/toolpanel" "Configurations2/menubar" "Configurations2/toolbar" "Configurations2/progressbar" "Configurations2/floater" |
︙ | ︙ | |||
219 220 221 222 223 224 225 | (map display ods:content-header) ;; process each sheet (map print (map ods:sheet data)) (map display ods:content-footer))) (system (conc "cd " path "; zip " fname " -n mimetype mimetype `find . |grep -v mimetype` > /dev/null"))))) | > | 225 226 227 228 229 230 231 232 | (map display ods:content-header) ;; process each sheet (map print (map ods:sheet data)) (map display ods:content-footer))) (system (conc "cd " path "; zip " fname " -n mimetype mimetype `find . |grep -v mimetype` > /dev/null"))))) ) |
Modified process.scm from [ba823d2c36] to [92c161e03c].
︙ | ︙ | |||
18 19 20 21 22 23 24 | ;;====================================================================== ;;====================================================================== ;; Process convience utils ;;====================================================================== | < > > > > > > > > > > | 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 | ;;====================================================================== ;;====================================================================== ;; Process convience utils ;;====================================================================== (declare (unit process)) (declare (uses common)) (module process * (import chicken scheme data-structures extras srfi-13 ports ) (import common) (use regex directory-utils) (define (process:conservative-read port) (let loop ((res "")) (if (not (eof-object? (peek-char port))) (loop (conc res (read-char port))) res))) |
︙ | ︙ | |||
219 220 221 222 223 224 225 | (res '())) (if (eof-object? inl) (reverse res) (let ((nums (map string->number (string-split-fields "\\d+" inl)))) (loop (read-line) (append res nums)))))))) | > | 228 229 230 231 232 233 234 235 | (res '())) (if (eof-object? inl) (reverse res) (let ((nums (map string->number (string-split-fields "\\d+" inl)))) (loop (read-line) (append res nums)))))))) ) |
Modified tests.scm from [b8a74e9d3b] to [becc588e0e].
︙ | ︙ | |||
18 19 20 21 22 23 24 | ;; ;;====================================================================== ;;====================================================================== ;; Tests ;;====================================================================== | < < < < > > > > > > > > > > > > | 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 47 48 49 50 51 52 53 | ;; ;;====================================================================== ;;====================================================================== ;; Tests ;;====================================================================== (declare (unit tests)) (declare (uses lock-queue)) (declare (uses db)) (declare (uses tdb)) (declare (uses common)) ;; (declare (uses dcommon)) ;; needed for the steps processing (declare (uses items)) (declare (uses runconfig)) ;; (declare (uses sdb)) (declare (uses server)) (module tests * (import chicken scheme data-structures extras srfi-13 ports ) (import common) (use sqlite3 srfi-1 posix regex regex-case srfi-69 dot-locking tcp directory-utils) (import (prefix sqlite3 sqlite3:)) (require-library stml) (include "common_records.scm") (include "key_records.scm") (include "db_records.scm") (include "run_records.scm") (include "test_records.scm") (include "js-path.scm") |
︙ | ︙ | |||
1934 1935 1936 1937 1938 1939 1940 | (define (test:archive db test-id) #f) (define (test:archive-tests db keynames target) #f) | > | 1942 1943 1944 1945 1946 1947 1948 1949 | (define (test:archive db test-id) #f) (define (test:archive-tests db keynames target) #f) ) |