;; Copyright 2006-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 <http://www.gnu.org/licenses/>.
(use sqlite3)
;;======================================================================
;; P R O C E S S E S
;;======================================================================
(test "process:cmd-run-with-stderr->list" '("No such file or directory")
(let ((reslst (process:cmd-run-with-stderr->list "ls" "/tmp/ihadbetternotexist")))
(string-search (regexp "No such file or directory")(car reslst))))
;;======================================================================
;; T E S T M A T C H I N G
;;======================================================================
;; tests:glob-like-match
(test #f '("abc") (tests:glob-like-match "abc" "abc"))
(for-each
(lambda (patt str expected)
(test (conc patt " " str "=>" expected) expected (tests:glob-like-match patt str)))
(list "abc" "~abc" "~abc" "a*c" "a%c")
(list "abc" "abcd" "abc" "ABC" "ABC")
(list '("abc") #t #f #f '("ABC"))
)
;; tests:match
(test #f #t (tests:match "abc/def" "abc" "def"))
(for-each
(lambda (patterns testname itempath expected)
(test (conc patterns " " testname "/" itempath "=>" expected)
expected
(tests:match patterns testname itempath)))
(list "abc" "abc/%" "ab%/c%" "~abc/c%" "abc/~c%" "a,b/c,%/d" "%/,%/a" "%/,%/a" "%/,%/a" "%" "%" "%/" "%/")
(list "abc" "abc" "abcd" "abc" "abc" "a" "abc" "def" "ghi" "a" "a" "a" "a")
(list "" "" "cde" "cde" "cde" "" "" "a" "b" "" "b" "" "b")
(list #t #t #t #f #f #t #t #t #f #t #t #t #f))
;; db:patt->like
(test #f "testname LIKE 't%'" (db:patt->like "testname" "t%" comparator: " AND "))
(test #f "testname LIKE 't%' AND testname LIKE '%t'" (db:patt->like "testname" "t%,%t" comparator: " AND "))
(test #f "item_path GLOB ''" (db:patt->like "item_path" ""))
;; test:match->sqlqry
(test #f "(testname GLOB 'a' AND item_path GLOB 'b') OR (testname LIKE 'a%' AND item_path LIKE '%') OR (testname GLOB '' AND item_path LIKE 'b%')"
(tests:match->sqlqry "a/b,a%,/b%"))
(test #f "(testname GLOB 'a' AND item_path GLOB 'b') OR (testname LIKE 'a%' AND item_path LIKE '%') OR (testname LIKE '%' AND item_path LIKE 'b%')"
(tests:match->sqlqry "a/b,a%,%/b%"))
(let* ((cmd "dunno")
(run-id 1)
(rid 1)
(rawcmd "dunno")
(params '())
(duration 100)
(connection-info (vector #f #f #f))
(dat "abc")
(json-str "\"def\"")
(item-path "a/b/c")
(test-id 1)
(testpatt "%/a/%")
(newstate "COMPLETED")
(newstatus "PASS")
(newcomment "Stupid comment")
(testnames '("test1" "test2"))
(currstate "COMPLETED")
(currstatus "FAIL")
(states '("COMPLETED" "RUNNING"))
(statuses '("PASS" "FAIL"))
(offset 100)
(limit 10)
(not-in #t)
(sort-by #f)
(sort-order #f)
(qryvals #f)
(qry 'a)
(synckey #f)
(keynum 1)
(run-ids '(1 2 3))
(state "RUNNING")
(status "FAIL")
(msg "Sillyness")
(test-name "test184")
(logf "/tmp/a.logfile")
(pid 1234567)
(target "a/b/c")
(res #f)
(runname "myfirstrun")
(statepatt "CO%")
(statuspatt "PA%")
(keynames '("SYSTEM" "RELEASE")) ;; "sysname" "fsname" "datapath"))
(waitons '("a" "b" "c"))
(ref-item-path "/d/e/f")
(jobgroup "anl")
(runpatt "run%")
(keyvals '(("SYSTEM" "a")("RELEASE" "b")))
(keys (map car keyvals))
(user "freddy")
(owner "tommy")
(count 100)
(keypatts '(("SYSTEM" "%a")("RELEASE" "%b")))
(lock #f)
(unlock #t)
(run-status "n/a")
(runnamepatt "b%")
(targpatt "%a/%b")
(fields "id,runname")
(ovr-deadtime 100)
(teststep-name "first")
(state-in "COMPLETED")
(status-in "FAIL")
(comment "This is a comment eh!")
(logfile "/tmp/alogfile.log")
(categorypatt "stats")
(work-area "/tmp")
(fld "owner")
(val 5)
(csvdata "id,meas,val\n1,voltage,2")
(action-patt "%")
(param-key "dunno")
(testname "atest")
(dneeded 10000)
(bdisk-id 1)
(archive-path "tmp")
(block-id 1)
(testsuite-name "fullrun")
(areakey "dunno")
(bdisk-name "what")
(bdisk-path "tmp")
(df 1000000)
(archive-block-id 1)
(stmtname 'blah))
(test #f #f (rmt:write-frequency-over-limit? cmd run-id))
(test #f #f (rmt:get-connection-info run-id))
(test #f #t (rmt:update-db-stats run-id rawcmd params duration))
(test #f #t (begin (rmt:print-db-stats) #t))
(test #f '(none . 0) (rmt:get-max-query-average run-id))
(test #f #f (rmt:send-receive-no-auto-client-setup connection-info cmd run-id params))
(test #f "\"abc\"" (rmt:dat->json-str dat))
(test #f "def" (rmt:json-str->dat json-str))
(test #f #f (rmt:kill-server run-id))
(test #f #t (begin (rmt:start-server run-id) #t))
(test #f '(#f "Login failed due to mismatch run-id: " 1 ", " #f) (rmt:login run-id))
(test #f #f (rmt:login-no-auto-client-setup connection-info run-id))
(test #f #t (begin (rmt:runtests user run-id testpatt params) #t))
(test #f '() (rmt:get-key-val-pairs run-id))
(test #f '("SYSTEM" "RELEASE") (rmt:get-keys))
(test #f '() (rmt:get-key-vals run-id))
(test #f (vector '("SYSTEM" "RELEASE") '()) (rmt:get-targets))
(test #f #t (rmt:register-test run-id test-name item-path))
(test #f #f (rmt:get-test-id run-id testname item-path))
(test #f #f (rmt:get-test-info-by-id run-id test-id))
(test #f #f (rmt:test-get-rundir-from-test-id run-id test-id))
(test #f #t (database? (rmt:open-test-db-by-test-id run-id test-id work-area: "/tmp")))
(test #f #t (begin (rmt:set-tests-state-status run-id testnames currstate currstatus newstate newstatus) #t))
(test #f '() (rmt:get-tests-for-run run-id testpatt states statuses offset limit not-in sort-by sort-order qryvals)) ;;;
(test #f #t (vector? (car (rmt:get-tests-for-runs-mindata run-ids testpatt states statuses not-in))))
(test #f #t (begin (rmt:delete-test-records run-id test-id) #t))
(test #f #t (begin (rmt:test-set-status-state run-id test-id status state msg) #t))
(test #f 1 (rmt:test-toplevel-num-items run-id test-name))
(test #f '() (rmt:get-matching-previous-test-run-records run-id test-name item-path))
(test #f #f (rmt:test-get-logfile-info run-id test-name))
(test #f #t (vector? (car (rmt:test-get-records-for-index-file run-id test-name))))
(test #f #f (rmt:get-testinfo-state-status run-id test-id))
(test #f #t (rmt:test-set-log! run-id test-id logf))
(test #f #t (begin (rmt:test-set-top-process-pid run-id test-id pid) #t))
(test #f #f (rmt:test-get-top-process-pid run-id test-id))
(test #f '() (rmt:get-run-ids-matching-target keynames target res runname testpatt statepatt statuspatt))
(test #f '() (rmt:test-get-paths-matching-keynames-target-new keynames target res testpatt statepatt statuspatt runname))
(test #f '("c" "b" "a") (rmt:get-prereqs-not-met run-id waitons ref-item-path)) ;; #!key (mode '(normal))(itemmap #f)))
(test #f 0 (rmt:get-count-tests-running-for-run-id run-id))
(test #f 0 (rmt:get-count-tests-running run-id))
(test #f 0 (rmt:get-count-tests-running-for-testname run-id testname))
(test #f 0 (rmt:get-count-tests-running-in-jobgroup run-id jobgroup))
(test #f #t (rmt:roll-up-pass-fail-counts run-id test-name item-path state status))
(test #f #t (rmt:update-pass-fail-counts run-id test-name))
(test #f #t (rmt:top-test-set-per-pf-counts run-id test-name))
(test #f #t (vector? (rmt:get-run-info run-id)))
(test #f 0 (rmt:get-num-runs runpatt))
(test #f 1 (rmt:register-run keyvals runname state status user))
(test #f "myfirstrun" (rmt:get-run-name-from-id run-id))
(test #f #t (begin (rmt:delete-run run-id) #t))
(test #f #t (begin (rmt:delete-old-deleted-test-records) #t))
(test #f #t (vector? (rmt:get-runs runpatt count offset keypatts)))
(test #f '() (rmt:get-all-run-ids))
(test #f '() (rmt:get-prev-run-ids run-id))
(test #f #t (begin (rmt:lock/unlock-run run-id lock unlock user) #t))
(test #f #t (begin (rmt:set-run-status run-id "NONPASS" msg: msg) #t)) ;; run-status
(test #f "NONPASS" (rmt:get-run-status run-id))
(test #f #t (begin (rmt:update-run-event_time run-id) #t))
(test #f (vector '("SYSTEM" "RELEASE" "id") '()) (rmt:get-runs-by-patt keys runnamepatt targpatt offset limit '("id"))) ;; fields of #f uses default)
(test #f #t (begin (rmt:find-and-mark-incomplete run-id ovr-deadtime) #t))
(test #f #t (begin (rmt:find-and-mark-incomplete-all-runs ovr-deadtime: ovr-deadtime) #t))
(test #f #f (rmt:get-previous-test-run-record run-id test-name item-path))
(test #f #t (begin (rmt:teststep-set-status! run-id test-id teststep-name state-in status-in comment logfile) #t))
(test #f #t (vector? (car (rmt:get-steps-for-test run-id test-id))))
(test #f '() (rmt:read-test-data run-id test-id categorypatt work-area: work-area))
(test #f #t (begin (rmt:testmeta-add-record testname) #t))
(test #f (vector 1 "atest" "" "" "" "" "" "" "" "" "default") (rmt:testmeta-get-record testname))
(test #f #t (begin (rmt:testmeta-update-field test-name fld val) #t))
(test #f #t (rmt:test-data-rollup run-id test-id status))
(test #f #t (begin (rmt:csv->test-data run-id test-id csvdata) #t))
(test #f '() (rmt:tasks-find-task-queue-records target runname testpatt statepatt action-patt))
(test #f #t (begin (rmt:tasks-add "action" owner target runname testpatt "params") #t))
(test #f #t (begin (rmt:tasks-set-state-given-param-key param-key newstate) #t))
(test #f #t (begin (rmt:test-set-state-status-by-id run-id test-id newstate newstatus newcomment) #t))
;;
;; (test #f #f (rmt:archive-get-allocations testname itempath dneeded))
;; (test #f #f (rmt:archive-register-block-name bdisk-id archive-path))
;; (test #f #f (rmt:archive-allocate-testsuite/area-to-block block-id testsuite-name areakey))
;; (test #f #f (rmt:archive-register-disk bdisk-name bdisk-path df))
;; (test #f #f (rmt:test-set-archive-block-id run-id test-id archive-block-id))
;; (test #f #f (rmt:test-get-archive-block-info archive-block-id))
;; Defer these a little while ...
;;
;; (test #f #f (rmt:synchash-get run-id proc synckey keynum params))
;; (test #f #f (rmt:send-receive cmd rid params #!key (attemptnum 1)) ;; start attemptnum at 1 so the modulo below works as expected)
;; (test #f #f (rmt:open-qry-close-locally cmd run-id params #!key (remretries 5)))
;; (test #f #f (apply rmt:general-call stmtname run-id params))
;; (test #f #f (rmt:sync-inmem->db run-id))
;; (test #f #f (rmt:sdb-qry qry val run-id))
;; Deprecated or removed
;;
;; (test #f #f (rmt:get-run-ids-matching keynames target res))
)
(exit)