| ︙ | | |
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
|
140
141
142
143
144
145
146
147
148
149
150
151
152
153
|
-
|
"-reqtarg"
":item"
":runname"
":state"
":status"
"-list-runs"
"-testpatt"
"-itempatt"
|
| ︙ | | |
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
|
233
234
235
236
237
238
239
240
241
242
243
244
245
246
|
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
|
(debug:setup)
(if (args:get-arg "-logging")(set! *logging* #t))
(if (debug:debug-mode 3) ;; we are obviously debugging
(set! open-run-close open-run-close-no-exception-handling))
;; a,b,c % => a/%,b/%,c/%
(define (tack-on-patt srcstr patt)
(let ((strlst (string-split srcstr ",")))
(string-intersperse
(map (lambda (str)
(if (not (substring-index "/" str))
(conc str "/" patt)
str))
strlst)
",")))
;; to try and not burden Kim too much...
(if (args:get-arg "-itempatt")
(let ((old-testpatt (args:get-arg "-testpatt")))
;; (debug:print 0 "ERROR: parameter \"-itempatt\" has been deprecated. For now I will tweak your -testpatt for you")
(if (args:get-arg "-testpatt")
(hash-table-set! args:arg-hash "-testpatt" (tack-on-patt old-testpatt (args:get-arg "-itempatt"))))
;; (debug:print 0 " old: " old-testpatt ", new: " (args:get-arg "-testpatt"))
(if (args:get-arg "-runtests")
(begin
;; (debug:print 0 "NOTE: Also modifying -runtests")
(hash-table-set! args:arg-hash "-runtests" (tack-on-patt (args:get-arg "-runtests")
(args:get-arg "-itempatt")))))
))
|
| ︙ | | |
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
|
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
|
-
+
|
(args:get-arg "-lock")
(args:get-arg "-unlock")
user))))
;;======================================================================
;; Get paths to tests
;;======================================================================
;; Get test paths matching target, runname, testpatt, and itempatt
;; Get test paths matching target, runname, and testpatt
(if (or (args:get-arg "-test-files")(args:get-arg "-test-paths"))
;; if we are in a test use the MT_CMDINFO data
(if (getenv "MT_CMDINFO")
(let* ((startingdir (current-directory))
(cmdinfo (read (open-input-string (base64:base64-decode (getenv "MT_CMDINFO")))))
(runremote (assoc/default 'runremote cmdinfo))
(testpath (assoc/default 'testpath cmdinfo))
|
| ︙ | | |
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
|
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
|
-
-
+
|
paths)))
;; else do a general-run-call
(general-run-call
"-test-files"
"Get paths to test"
(lambda (target runname keys keynames keyvallst)
(let* ((db #f)
(itempatt (args:get-arg "-itempatt"))
;; Archive tests matching target, runname, testpatt, and itempatt
;; Archive tests matching target, runname, and testpatt
(if (args:get-arg "-archive")
;; if we are in a test use the MT_CMDINFO data
(if (getenv "MT_CMDINFO")
(let* ((startingdir (current-directory))
(cmdinfo (read (open-input-string (base64:base64-decode (getenv "MT_CMDINFO")))))
(runremote (assoc/default 'runremote cmdinfo))
(testpath (assoc/default 'testpath cmdinfo))
|
| ︙ | | |
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
|
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
|
-
-
+
-
|
(begin
(debug:print 0 "ERROR: -target is required.")
(exit 1)))
(if (not (setup-for-run))
(begin
(debug:print 0 "Failed to setup, giving up on -archive, exiting")
(exit 1)))
(let* ((itempatt (args:get-arg "-itempatt"))
(keys (open-run-close db:get-keys db))
(itempatt (args:get-arg "-itempatt"))
|
| ︙ | | |