Megatest

Diff
Login

Differences From Artifact [25f8e62ccc]:

To Artifact [0ab429c3d5]:


1815
1816
1817
1818
1819
1820
1821
1822

1823
1824
1825
1826
1827
1828
1829

1830
1831

1832
1833
1834
1835

1836
1837


1838
1839
1840
1841
1842
1843
1844
1815
1816
1817
1818
1819
1820
1821

1822
1823
1824
1825
1826
1827
1828

1829
1830

1831
1832
1833
1834
1835
1836


1837
1838
1839
1840
1841
1842
1843
1844
1845







-
+






-
+

-
+




+
-
-
+
+







(define (megatest:step step state status logfile msg)
  (if (not (getenv "MT_CMDINFO"))
      (begin
	(debug:print-error 0 *default-log-port* "MT_CMDINFO env var not set, -step must be called *inside* a megatest invoked environment!")
	(exit 5))
      (let* ((cmdinfo   (common:read-encoded-string (getenv "MT_CMDINFO")))
	     (transport (assoc/default 'transport cmdinfo))
	     ;; (testpath  (assoc/default 'testpath  cmdinfo))
	     (testpath  (assoc/default 'testpath  cmdinfo)) ;; the test source area
	     (test-name (assoc/default 'test-name cmdinfo))
	     (runscript (assoc/default 'runscript cmdinfo))
	     (db-host   (assoc/default 'db-host   cmdinfo))
	     (run-id    (assoc/default 'run-id    cmdinfo))
	     (test-id   (assoc/default 'test-id   cmdinfo))
	     (itemdat   (assoc/default 'itemdat   cmdinfo))
	     (work-area (assoc/default 'work-area cmdinfo))
	     ;; (work-area (assoc/default 'work-area cmdinfo)) ;; the test run area, no longer available from cmdinfo
	     (db        #f)
	     (testpath  #f))
	     (work-area #f))
	(if (not (launch:setup))
	    (begin
	      (debug:print 0 *default-log-port* "Failed to setup, exiting")
	      (exit 1)))
	(let* ((testdat   (rmt:get-test-info-by-id run-id test-id)))
	(set! testpath (db:test-get-rundir testdat))
	(change-directory testpath)
	  (set! work-area (db:test-get-rundir testdat)))
	(change-directory work-area) ;; why would this have ever been testpath? Makes no sense
	(if (and state status)
	    (let ((comment (launch:load-logpro-dat run-id test-id step)))
	      ;; (rmt:test-set-log! run-id test-id (conc stepname ".html"))))
	      (rmt:teststep-set-status! run-id test-id step state status (or comment msg) logfile))
	    (begin
	      (debug:print-error 0 *default-log-port* "You must specify :state and :status with every call to -step")
	      (exit 6))))))
1866
1867
1868
1869
1870
1871
1872
1873

1874
1875
1876
1877
1878
1879
1880

1881
1882
1883
1884
1885
1886

1887
1888
1889
1890
1891
1892


1893
1894
1895
1896
1897
1898
1899
1867
1868
1869
1870
1871
1872
1873

1874
1875
1876
1877
1878
1879
1880

1881
1882
1883
1884
1885


1886
1887
1888
1889
1890

1891
1892
1893
1894
1895
1896
1897
1898
1899
1900







-
+






-
+




-
-
+




-

+
+







    (if (not (getenv "MT_CMDINFO"))
	(begin
	  (debug:print-error 0 *default-log-port* "MT_CMDINFO env var not set, commands -test-status, -runstep and -setlog must be called *inside* a megatest environment!")
	  (exit 5))
	(let* ((startingdir (current-directory))
	       (cmdinfo   (common:read-encoded-string (getenv "MT_CMDINFO")))
	       (transport (assoc/default 'transport cmdinfo))
	       ;; (testpath  (assoc/default 'testpath  cmdinfo))
	       (testpath  (assoc/default 'testpath  cmdinfo)) ;; source area for test files
	       (test-name (assoc/default 'test-name cmdinfo))
	       (runscript (assoc/default 'runscript cmdinfo))
	       (db-host   (assoc/default 'db-host   cmdinfo))
	       (run-id    (assoc/default 'run-id    cmdinfo))
	       (test-id   (assoc/default 'test-id   cmdinfo))
	       (itemdat   (assoc/default 'itemdat   cmdinfo))
	       (work-area (assoc/default 'work-area cmdinfo))
	       ;; (work-area (assoc/default 'work-area cmdinfo))  ;; the area where the test runs, no longer available from cmdinfo
	       (db        #f) ;; (open-db))
	       (state     (args:get-arg ":state"))
	       (status    (args:get-arg ":status"))
	       (stepname  (args:get-arg "-step"))
	       (testdat   (rmt:get-test-info-by-id run-id test-id))
	       (testpath  #f)) ;; fill in missing data below
	       (work-area #f))
	  (if (not (launch:setup))
	      (begin
		(debug:print 0 *default-log-port* "Failed to setup, exiting")
		(exit 1)))
	  (set! testpath (db:test-get-rundir testdat))
	  (if (args:get-arg "-runstep")(debug:print-info 1 *default-log-port* "Running -runstep, first change to directory " work-area))
	  (let* ((testdat   (rmt:get-test-info-by-id run-id test-id)))
	    (set! work-area (db:test-get-rundir testdat)))
	  (change-directory work-area)
	  ;; 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 rmt: or open-run-close