Megatest

Check-in [50b13e991f]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Extended support for exit info to non-ezsteps
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.61
Files: files | file ages | folders
SHA1: 50b13e991f401f12b8659accea2e3ec5daa1b8a9
User & Date: mrwellan on 2016-05-10 13:36:43
Other Links: branch diff | manifest | tags
Context
2016-05-10
17:44
Corrected ordering of data in test_data storage of logpro rule results. check-in: bdfd79da2e user: mrwellan tags: v1.61
13:36
Extended support for exit info to non-ezsteps check-in: 50b13e991f user: mrwellan tags: v1.61
11:57
Added message to test steps panel check-in: b0c7d17ae2 user: mrwellan tags: v1.61
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified launch.scm from [d6ba0a847e] to [5106e6791d].

︙
58
59
60
61
62
63
64


65
66
67
68
69
70
71
72
73
74
75












76
77
78
79
80
81
82

58
59
60
61
62
63
64
65
66











67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85








+
+
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+








;;                       0           1              2              3
(defstruct launch:einf (pid #t)(exit-status #t)(exit-code #t)(rollup-status 0))

;; return (conc status ": " comment) from the final section so that
;;   the comment can be set in the step record in launch.scm
;;
(define (launch:load-logpro-dat run-id test-id stepname)
  (let ((cname (conc stepname ".dat")))
    (if (file-exists? cname)
  (let* ((dat  (read-config (conc stepname ".dat") #f #f))
	 (csvr (db:logpro-dat->csv dat stepname))
	 (csvt (let-values (( (fmt-cell fmt-record fmt-csv) (make-format ",")))
			   (fmt-csv (map list->csv-record csvr))))
	 (status (configf:lookup dat "final" "exit-status"))
	 (msg     (configf:lookup dat "final" "message")))
    (rmt:csv->test-data run-id test-id csvt)
    (cond
     ((equal? status "PASS") "PASS") ;; skip the message part if status is pass
     (status (conc (configf:lookup dat "final" "exit-status") ": " (configf:lookup dat "final" "message")))
     (else #f))))
	(let* ((dat  (read-config cname #f #f))
	       (csvr (db:logpro-dat->csv dat stepname))
	       (csvt (let-values (( (fmt-cell fmt-record fmt-csv) (make-format ",")))
				 (fmt-csv (map list->csv-record csvr))))
	       (status (configf:lookup dat "final" "exit-status"))
	       (msg     (configf:lookup dat "final" "message")))
	  (rmt:csv->test-data run-id test-id csvt)
	  (cond
	   ((equal? status "PASS") "PASS") ;; skip the message part if status is pass
	   (status (conc (configf:lookup dat "final" "exit-status") ": " (configf:lookup dat "final" "message")))
	   (else #f)))
	#f)))

(define (launch:runstep ezstep run-id test-id exit-info m tal testconfig)
  (let* ((stepname       (car ezstep))  ;; do stuff to run the step
	 (stepinfo       (cadr ezstep))
	 (stepparts      (string-match (regexp "^(\\{([^\\}]*)\\}\\s*|)(.*)$") stepinfo))
	 (stepparms      (list-ref stepparts 2)) ;; for future use, {VAR=1,2,3}, run step for each 
	 (stepcmd        (list-ref stepparts 3))
︙

Modified megatest.scm from [d6a8fb9170] to [018155474b].

︙
1627
1628
1629
1630
1631
1632
1633


1634

1635
1636
1637
1638
1639
1640
1641

1627
1628
1629
1630
1631
1632
1633
1634
1635

1636
1637
1638
1639
1640
1641
1642
1643








+
+
-
+








	     (db        #f))
	(change-directory testpath)
	(if (not (launch:setup))
	    (begin
	      (debug:print 0 "Failed to setup, exiting")
	      (exit 1)))
	(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 msg logfile)
	      (rmt:teststep-set-status! run-id test-id step state status (or comment msg) logfile))
	    (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
︙
1669
1670
1671
1672
1673
1674
1675
1676


1677
1678
1679
1680
1681
1682
1683

1671
1672
1673
1674
1675
1676
1677

1678
1679
1680
1681
1682
1683
1684
1685
1686








-
+
+








	       (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))
	       (db        #f) ;; (open-db))
	       (state     (args:get-arg ":state"))
	       (status    (args:get-arg ":status")))
	       (status    (args:get-arg ":status"))
	       (stepname  (args:get-arg "-step")))
	  (if (not (launch:setup))
	      (begin
		(debug:print 0 "Failed to setup, exiting")
		(exit 1)))

	  (if (args:get-arg "-runstep")(debug:print-info 1 "Running -runstep, first change to directory " work-area))
	  (change-directory work-area)
︙

Modified tests.scm from [7314e1d8ff] to [741f407659].

︙
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646

632
633
634
635
636
637
638

639
640
641
642
643
644
645








-








       (sort steps (lambda (a b)
		     (cond
		      ((<   (tdb:step-get-event_time a)(tdb:step-get-event_time b)) #t)
		      ((eq? (tdb:step-get-event_time a)(tdb:step-get-event_time b)) 
		       (<   (tdb:step-get-id a)        (tdb:step-get-id b)))
		      (else #f)))))
      res))


;; 
;;
(define (tests:get-compressed-steps run-id test-id)
  (let* ((steps-data  (rmt:get-steps-for-test run-id test-id))
	 (comprsteps  (tests:process-steps-table steps-data))) ;; (open-run-close db:get-steps-table #f test-id work-area: work-area)))
    (map (lambda (x)
︙

This page was generated in about 0.109s by Fossil 2.24 [452f8e1ffc] 2024-03-26 15:36:00