Megatest

misc.scm at [e174a07c36]
Login

File tests/unittests/misc.scm artifact 13ac5e1e6e part of check-in e174a07c36


;;  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)