Megatest

Changes On Branch stderr-capture
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Hide Diff Patch Side-by-Side Diff

Changes In Branch stderr-capture Excluding Merge-Ins

This is equivalent to a diff from 2d26c7fb2e to a7d93e42e4

2012-10-08
23:12
Merged in feature branch stderr-capture (works ok) check-in: 8ee92f3656 user: matt tags: trunk
23:07
Fixes to install.sh check-in: e021104301 user: matt tags: update-installall.sh
23:05
Added ability to log to sqlite3 db Closed-Leaf check-in: 29d7b1ec12 user: matt tags: logging-to-db
22:58
Added stderr capture on launch Closed-Leaf check-in: a7d93e42e4 user: matt tags: test4-clean-fast, stderr-capture
22:44
Merged b2448 into trunk, passes test4 check-in: 2d26c7fb2e user: matt tags: trunk, test4-clean
22:39
Added kill target for forced clean up check-in: ff4a2d4f85 user: matt tags: trunk
11:38
Added logging to an sqlite3 db, updated installall.sh to latest chicken and iup releases, proper capture of stderr on launch process. check-in: 69482225b7 user: mrwellan tags: rpc-db-access, these-changes-moved-to-logging-to-db-branch
2012-10-07
22:50
Merged couple more changes from test-specific-db check-in: b2448ef0d3 user: mrwellan tags: rpc-db-access, test4-clean

Modified launch.scm from [0714961a30] to [dc96227333].

︙
603
604
605
606
607
608
609
610

611
612
613
614

615
616
617
618
619
620
621

603
604
605
606
607
608
609

610
611
612
613

614
615
616
617
618
619
620
621








-
+



-
+








			    (append (list (list "MT_TEST_RUN_DIR" work-area)
					  (list "MT_TEST_NAME" test-name)
					  (list "MT_ITEM_INFO" (conc itemdat)) 
					  (list "MT_RUNNAME"   runname)
					  (list "MT_TARGET"    mt_target)
					  )
				    itemdat)))
	   (launch-results (apply cmd-run-proc-each-line
	   (launch-results (apply cmd-run-with-stderr->list ;; cmd-run-proc-each-line
				  (if useshell
				      (string-intersperse fullcmd " ")
				      (car fullcmd))
				  print
				  ;; conc
				  (if useshell
				      '()
				      (cdr fullcmd))))) ;;  launcher fullcmd)));; (apply cmd-run-proc-each-line launcher print fullcmd))) ;; (cmd-run->list fullcmd))
      (with-output-to-file "mt_launch.log"
	(lambda ()
	  (apply print launch-results)))
      (debug:print 2 "Launching completed, updating db")
︙

Modified process.scm from [71a058a91c] to [444a7f5a5f].

︙
11
12
13
14
15
16
17































18
19
20
21
22
23
24
25
26
27
28
29

30
31
32
33
34
35

36
37
38
39
40
41
42

11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59

60
61
62
63
64
65
66
67
68
69
70
71
72
73
74








+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+











-
+






+









;;======================================================================
;; Process convience utils
;;======================================================================

(declare (unit process))
(declare (uses common))

(define (conservative-read port)
  (let loop ((res ""))
    (if (not (eof-object? (peek-char port)))
	(loop (conc res (read-char port)))
	res)))
    
(define (cmd-run-with-stderr->list cmd . params)
  ;; (print "Called with cmd=" cmd ", proc=" proc ", params=" params)
;;  (handle-exceptions
;;   exn
;;   (begin
;;     (print "ERROR:  Failed to run command: " cmd " " (string-intersperse params " "))
;;     (print "       " ((condition-property-accessor 'exn 'message) exn))
;;     #f)
   (let-values (((fh fho pid fhe) (if (null? params)
				      (process* cmd)
				      (process* cmd params))))
       (let loop ((curr (read-line fh))
		  (result  '()))
	 (let ((errstr (conservative-read fhe)))
	   (if (not (string=? errstr ""))
	       (set! result (append result (list errstr)))))
       (if (not (eof-object? curr))
	   (loop (read-line fh)
		 (append result (list curr)))
	   (begin
	     (close-input-port fh)
	     (close-input-port fhe)
	     (close-output-port fho)
	     result))))) ;; )

(define (cmd-run-proc-each-line cmd proc . params)
  ;; (print "Called with cmd=" cmd ", proc=" proc ", params=" params)
  (handle-exceptions
   exn
   (begin
     (print "ERROR:  Failed to run command: " cmd " " (string-intersperse params " "))
     #f)
   (let-values (((fh fho pid) (if (null? params)
				  (process cmd)
				  (process cmd params))))
     (let loop ((curr (read-line fh))
       (let loop ((curr (read-line fh))
		(result  '()))
       (if (not (eof-object? curr))
	   (loop (read-line fh)
		 (append result (list (proc curr))))
	   (begin
	     (close-input-port fh)
	     (close-input-port fhe)
	     (close-output-port fho)
	     result))))))

(define (cmd-run-proc-each-line-alt cmd proc)
  (let* ((fh (open-input-pipe cmd))
         (res (port-proc->list fh proc))
         (status (close-input-pipe fh)))
︙

Modified tests/tests.scm from [69324af198] to [6debbc62bb]. 

1

2
3
4
5
6
7
8
9
10
11












12
13
14
15
16
17
18

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31


+










+
+
+
+
+
+
+
+
+
+
+
+








(require-extension test)
(require-extension regex)

(define test-work-dir (current-directory))

;; read in all the _record files
(let ((files (glob "*_records.scm")))
  (for-each
   (lambda (file)
     (print "Loading " file)
     (load file))
   files))

;;======================================================================
;; P R O C E S S E S
;;======================================================================

(test "cmd-run-with-stderr->list" '("No such file or directory")
      (let ((reslst (cmd-run-with-stderr->list "ls" "/tmp/ihadbetternotexist")))
	(string-search (regexp "No such file or directory")(car reslst))))

;;======================================================================
;; C O N F I G   F I L E S 
;;======================================================================

(define conffile #f)
(test "Read a config" #t (hash-table? (read-config "test.config" #f #f)))
(test "Read a config that doesn't exist" #t (hash-table? (read-config "nada.config" #f #f)))

(set! conffile (read-config "test.config" #f #f))
(test "Get available diskspace" #t (number? (get-df "./")))
︙

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