| ︙ | | |
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
|
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
|
+
+
+
+
+
+
-
-
+
+
+
|
(include "common_records.scm")
(include "key_records.scm")
(include "db_records.scm")
(include "megatest-fossil-hash.scm")
;; (use trace dot-locking)
;; (trace
;; db:teststep-set-status!
;; db:open-test-db-by-test-id
;; db:test-get-rundir-from-test-id
;; cdb:tests-register-test
;; cdb:tests-update-uname-host
;; cdb:tests-update-run-duration
;; cdb:client-call
;; cdb:remote-run
;; ;; cdb:client-call
;; ;; cdb:remote-run
;; )
;; cdb:test-set-status-state
;; change-directory
;; db:process-queue-item
;; db:test-get-logfile-info
;; db:teststep-set-status!
;; nice-path
;; obtain-dot-lock
|
| ︙ | | |
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
|
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
|
-
-
+
+
-
+
+
|
;; (set! *runremote* runremote)
(set! *transport-type* (string->symbol transport))
(if (not (setup-for-run))
(begin
(debug:print 0 "Failed to setup, exiting")
(exit 1)))
(if (and state status)
;; DO NOT remote run
(db:teststep-set-status! db test-id step state status msg logfile)
;; DO NOT remote run, makes calls to the testdat.db test db.
(db:teststep-set-status! db test-id step state status msg logfile testpath: testpath)
(begin
(debug:print 0 "ERROR: You must specify :state and :status with every call to -step")
(exit 6))))))
(if (args:get-arg "-step")
(begin
(megatest:step
(args:get-arg "-step")
(args:get-arg ":state")
(args:get-arg ":status")
(args:get-arg "-setlog")
(args:get-arg "-m"))
;; (if db (sqlite3:finalize! db))
(set! *didsomething* #t)))
(if (or (args:get-arg "-setlog") ;; since setting up is so costly lets piggyback on -test-status
(if (or (and (args:get-arg "-setlog") ;; since setting up is so costly lets piggyback on -test-status
(not (args:get-arg "-step"))) ;; -setlog may have been processed already in the "-step" previous
(args:get-arg "-set-toplog")
(args:get-arg "-test-status")
(args:get-arg "-set-values")
(args:get-arg "-load-test-data")
(args:get-arg "-runstep")
(args:get-arg "-summarize-items"))
(if (not (getenv "MT_CMDINFO"))
|
| ︙ | | |
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
|
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
|
-
+
|
;; can setup as client for server mode now
;; (client:setup)
(if (args:get-arg "-load-test-data")
;; has sub commands that are rdb:
;; DO NOT put this one into either cdb:remote-run or open-run-close
(db:load-test-data db test-id))
(db:load-test-data db test-id testpath: testpath))
(if (args:get-arg "-setlog")
(let ((logfname (args:get-arg "-setlog")))
(cdb:test-set-log! *runremote* test-id logfname)))
(if (args:get-arg "-set-toplog")
;; DO NOT run remote
(tests:test-set-toplog! db run-id test-name (args:get-arg "-set-toplog")))
(if (args:get-arg "-summarize-items")
|
| ︙ | | |
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
|
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
|
-
+
-
+
|
((zsh bash sh ash) "2>&1 >")
(else ">&")))
(fullcmd (conc "(" (string-intersperse
(cons cmd params) " ")
") " redir " " logfile)))
;; mark the start of the test
;; DO NOT run remote
(db:teststep-set-status! db test-id stepname "start" "n/a" (args:get-arg "-m") logfile)
(db:teststep-set-status! db test-id stepname "start" "n/a" (args:get-arg "-m") logfile testpath: testpath)
;; run the test step
(debug:print-info 2 "Running \"" fullcmd "\"")
(change-directory startingdir)
(set! exitstat (system fullcmd)) ;; cmd params))
(set! *globalexitstatus* exitstat)
(change-directory testpath)
;; run logpro if applicable ;; (process-run "ls" (list "/foo" "2>&1" "blah.log"))
(if logprofile
(let* ((htmllogfile (conc stepname ".html"))
(oldexitstat exitstat)
(cmd (string-intersperse (list "logpro" logprofile htmllogfile "<" logfile ">" (conc stepname "_logpro.log")) " ")))
(debug:print-info 2 "running \"" cmd "\"")
(change-directory startingdir)
(set! exitstat (system cmd))
(set! *globalexitstatus* exitstat) ;; no necessary
(change-directory testpath)
(cdb:test-set-log! *runremote* test-id htmllogfile)))
(let ((msg (args:get-arg "-m")))
;; DO NOT run remote
(db:teststep-set-status! db test-id stepname "end" exitstat msg logfile))
(db:teststep-set-status! db test-id stepname "end" exitstat msg logfile testpath: testpath))
)))
(if (or (args:get-arg "-test-status")
(args:get-arg "-set-values"))
(let ((newstatus (cond
((number? status) (if (equal? status 0) "PASS" "FAIL"))
((and (string? status)
(string->number status))(if (equal? (string->number status) 0) "PASS" "FAIL"))
|
| ︙ | | |
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
|
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
|
-
+
|
(begin
(debug:print 0 "ERROR: You must specify :state and :status with every call to -test-status\n" help)
;; (sqlite3:finalize! db)
(exit 6)))
(let* ((msg (args:get-arg "-m"))
(numoth (length (hash-table-keys otherdata))))
;; Convert to rpc inside the tests:test-set-status! call, not here
(tests:test-set-status! test-id state newstatus msg otherdata))))
(tests:test-set-status! test-id state newstatus msg otherdata testpath: testpath))))
(if db (sqlite3:finalize! db))
(set! *didsomething* #t))))
;;======================================================================
;; Various helper commands can go below here
;;======================================================================
|
| ︙ | | |