Artifact d31db054ad759d56c864b1eac8fae2b9c434f791:
- File process.scm — part of check-in [ae6dbecf17] at 2011-05-01 23:05:22 on branch trunk — Importing 1.0.1 version of megatest, (nb// work in progress, please wait for next release) (user: matt size: 2309)
0000: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;============== 0010: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0020: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0030: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0040: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 43 6f 70 79 ========.;; Copy 0050: 72 69 67 68 74 20 32 30 30 36 2d 32 30 31 31 2c right 2006-2011, 0060: 20 4d 61 74 74 68 65 77 20 57 65 6c 6c 61 6e 64 Matthew Welland 0070: 2e 0a 3b 3b 20 0a 3b 3b 20 20 54 68 69 73 20 70 ..;; .;; This p 0080: 72 6f 67 72 61 6d 20 69 73 20 6d 61 64 65 20 61 rogram is made a 0090: 76 61 69 6c 61 62 6c 65 20 75 6e 64 65 72 20 74 vailable under t 00a0: 68 65 20 47 4e 55 20 47 50 4c 20 76 65 72 73 69 he GNU GPL versi 00b0: 6f 6e 20 32 2e 30 20 6f 72 0a 3b 3b 20 20 67 72 on 2.0 or.;; gr 00c0: 65 61 74 65 72 2e 20 53 65 65 20 74 68 65 20 61 eater. See the a 00d0: 63 63 6f 6d 70 61 6e 79 69 6e 67 20 66 69 6c 65 ccompanying file 00e0: 20 43 4f 50 59 49 4e 47 20 66 6f 72 20 64 65 74 COPYING for det 00f0: 61 69 6c 73 2e 0a 3b 3b 20 0a 3b 3b 20 20 54 68 ails..;; .;; Th 0100: 69 73 20 70 72 6f 67 72 61 6d 20 69 73 20 64 69 is program is di 0110: 73 74 72 69 62 75 74 65 64 20 57 49 54 48 4f 55 stributed WITHOU 0120: 54 20 41 4e 59 20 57 41 52 52 41 4e 54 59 3b 20 T ANY WARRANTY; 0130: 77 69 74 68 6f 75 74 20 65 76 65 6e 20 74 68 65 without even the 0140: 0a 3b 3b 20 20 69 6d 70 6c 69 65 64 20 77 61 72 .;; implied war 0150: 72 61 6e 74 79 20 6f 66 20 4d 45 52 43 48 41 4e ranty of MERCHAN 0160: 54 41 42 49 4c 49 54 59 20 6f 72 20 46 49 54 4e TABILITY or FITN 0170: 45 53 53 20 46 4f 52 20 41 20 50 41 52 54 49 43 ESS FOR A PARTIC 0180: 55 4c 41 52 0a 3b 3b 20 20 50 55 52 50 4f 53 45 ULAR.;; PURPOSE 0190: 2e 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;============ 01a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 01b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 01c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 01d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 3d 3d ==========..;;== 01e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 01f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0200: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0210: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0220: 3d 3d 3d 3d 0a 3b 3b 20 50 72 6f 63 65 73 73 20 ====.;; Process 0230: 63 6f 6e 76 69 65 6e 63 65 20 75 74 69 6c 73 0a convience utils. 0240: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;============== 0250: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0260: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0270: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0280: 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 69 6e ========..(defin 0290: 65 20 28 63 6d 64 2d 72 75 6e 2d 70 72 6f 63 2d e (cmd-run-proc- 02a0: 65 61 63 68 2d 6c 69 6e 65 20 63 6d 64 20 70 72 each-line cmd pr 02b0: 6f 63 20 2e 20 70 61 72 61 6d 73 29 0a 20 20 28 oc . params). ( 02c0: 6c 65 74 2a 20 28 28 66 68 20 28 70 72 6f 63 65 let* ((fh (proce 02d0: 73 73 20 63 6d 64 20 70 61 72 61 6d 73 29 29 29 ss cmd params))) 02e0: 0a 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 . (let loop ( 02f0: 28 63 75 72 72 20 28 72 65 61 64 2d 6c 69 6e 65 (curr (read-line 0300: 20 66 68 29 29 0a 20 20 20 20 20 20 20 20 20 20 fh)). 0310: 20 20 20 20 20 28 72 65 73 75 6c 74 20 20 27 28 (result '( 0320: 29 29 29 0a 20 20 20 20 20 20 28 69 66 20 28 6e ))). (if (n 0330: 6f 74 20 28 65 6f 66 2d 6f 62 6a 65 63 74 3f 20 ot (eof-object? 0340: 63 75 72 72 29 29 0a 20 20 20 20 20 20 20 20 20 curr)). 0350: 20 28 6c 6f 6f 70 20 28 72 65 61 64 2d 6c 69 6e (loop (read-lin 0360: 65 20 66 68 29 0a 20 20 20 20 20 20 20 20 20 20 e fh). 0370: 20 20 20 20 20 20 28 61 70 70 65 6e 64 20 72 65 (append re 0380: 73 75 6c 74 20 28 6c 69 73 74 20 28 70 72 6f 63 sult (list (proc 0390: 20 63 75 72 72 29 29 29 29 0a 20 20 20 20 20 20 curr)))). 03a0: 20 20 20 20 72 65 73 75 6c 74 29 29 29 29 0a 0a result)))).. 03b0: 28 64 65 66 69 6e 65 20 28 63 6d 64 2d 72 75 6e (define (cmd-run 03c0: 2d 70 72 6f 63 2d 65 61 63 68 2d 6c 69 6e 65 2d -proc-each-line- 03d0: 61 6c 74 20 63 6d 64 20 70 72 6f 63 29 0a 20 20 alt cmd proc). 03e0: 28 6c 65 74 2a 20 28 28 66 68 20 28 6f 70 65 6e (let* ((fh (open 03f0: 2d 69 6e 70 75 74 2d 70 69 70 65 20 63 6d 64 29 -input-pipe cmd) 0400: 29 0a 20 20 20 20 20 20 20 20 20 28 72 65 73 20 ). (res 0410: 28 70 6f 72 74 2d 70 72 6f 63 2d 3e 6c 69 73 74 (port-proc->list 0420: 20 66 68 20 70 72 6f 63 29 29 0a 20 20 20 20 20 fh proc)). 0430: 20 20 20 20 28 73 74 61 74 75 73 20 28 63 6c 6f (status (clo 0440: 73 65 2d 69 6e 70 75 74 2d 70 69 70 65 20 66 68 se-input-pipe fh 0450: 29 29 29 0a 20 20 20 20 28 69 66 20 28 65 71 3f ))). (if (eq? 0460: 20 73 74 61 74 75 73 20 30 29 20 72 65 73 20 23 status 0) res # 0470: 66 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 f)))..(define (c 0480: 6d 64 2d 72 75 6e 2d 3e 6c 69 73 74 20 63 6d 64 md-run->list cmd 0490: 29 0a 20 20 28 6c 65 74 2a 20 28 28 66 68 20 28 ). (let* ((fh ( 04a0: 6f 70 65 6e 2d 69 6e 70 75 74 2d 70 69 70 65 20 open-input-pipe 04b0: 63 6d 64 29 29 0a 20 20 20 20 20 20 20 20 20 28 cmd)). ( 04c0: 72 65 73 20 28 70 6f 72 74 2d 3e 6c 69 73 74 20 res (port->list 04d0: 66 68 29 29 0a 20 20 20 20 20 20 20 20 20 28 73 fh)). (s 04e0: 74 61 74 75 73 20 28 63 6c 6f 73 65 2d 69 6e 70 tatus (close-inp 04f0: 75 74 2d 70 69 70 65 20 66 68 29 29 29 0a 20 20 ut-pipe fh))). 0500: 20 20 28 6c 69 73 74 20 72 65 73 20 73 74 61 74 (list res stat 0510: 75 73 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 us)))..(define ( 0520: 70 6f 72 74 2d 3e 6c 69 73 74 20 66 68 29 0a 20 port->list fh). 0530: 20 28 69 66 20 28 65 6f 66 2d 6f 62 6a 65 63 74 (if (eof-object 0540: 3f 20 66 68 29 20 23 66 0a 20 20 20 20 20 20 28 ? fh) #f. ( 0550: 6c 65 74 20 6c 6f 6f 70 20 28 28 63 75 72 72 20 let loop ((curr 0560: 28 72 65 61 64 2d 6c 69 6e 65 20 66 68 29 29 0a (read-line fh)). 0570: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0580: 20 28 72 65 73 75 6c 74 20 27 28 29 29 29 0a 20 (result '())). 0590: 20 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 (if (not 05a0: 28 65 6f 66 2d 6f 62 6a 65 63 74 3f 20 63 75 72 (eof-object? cur 05b0: 72 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 r)). 05c0: 28 6c 6f 6f 70 20 28 72 65 61 64 2d 6c 69 6e 65 (loop (read-line 05d0: 20 66 68 29 0a 20 20 20 20 20 20 20 20 20 20 20 fh). 05e0: 20 20 20 20 20 20 20 28 61 70 70 65 6e 64 20 72 (append r 05f0: 65 73 75 6c 74 20 28 6c 69 73 74 20 63 75 72 72 esult (list curr 0600: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))). 0610: 72 65 73 75 6c 74 29 29 29 29 0a 0a 28 64 65 66 result))))..(def 0620: 69 6e 65 20 28 70 6f 72 74 2d 70 72 6f 63 2d 3e ine (port-proc-> 0630: 6c 69 73 74 20 66 68 20 70 72 6f 63 29 0a 20 20 list fh proc). 0640: 28 69 66 20 28 65 6f 66 2d 6f 62 6a 65 63 74 3f (if (eof-object? 0650: 20 66 68 29 20 23 66 0a 20 20 20 20 20 20 28 6c fh) #f. (l 0660: 65 74 20 6c 6f 6f 70 20 28 28 63 75 72 72 20 28 et loop ((curr ( 0670: 70 72 6f 63 20 28 72 65 61 64 2d 6c 69 6e 65 20 proc (read-line 0680: 66 68 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 fh))). 0690: 20 20 20 20 20 20 20 28 72 65 73 75 6c 74 20 27 (result ' 06a0: 28 29 29 29 0a 20 20 20 20 20 20 20 20 28 69 66 ())). (if 06b0: 20 28 6e 6f 74 20 28 65 6f 66 2d 6f 62 6a 65 63 (not (eof-objec 06c0: 74 3f 20 63 75 72 72 29 29 0a 20 20 20 20 20 20 t? curr)). 06d0: 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 6c 65 74 (loop (let 06e0: 20 28 28 6c 20 28 72 65 61 64 2d 6c 69 6e 65 20 ((l (read-line 06f0: 66 68 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 fh))). 0700: 20 20 20 20 20 20 20 20 20 20 28 69 66 20 28 65 (if (e 0710: 6f 66 2d 6f 62 6a 65 63 74 3f 20 6c 29 20 6c 20 of-object? l) l 0720: 28 70 72 6f 63 20 6c 29 29 29 0a 20 20 20 20 20 (proc l))). 0730: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 70 (ap 0740: 70 65 6e 64 20 72 65 73 75 6c 74 20 28 6c 69 73 pend result (lis 0750: 74 20 63 75 72 72 29 29 29 0a 20 20 20 20 20 20 t curr))). 0760: 20 20 20 20 20 20 72 65 73 75 6c 74 29 29 29 29 result)))) 0770: 0a 0a 3b 3b 20 68 65 72 65 20 69 73 20 61 6e 20 ..;; here is an 0780: 65 78 61 6d 70 6c 65 20 6c 69 6e 65 20 77 68 65 example line whe 0790: 72 65 20 74 68 65 20 73 68 65 6c 6c 20 69 73 20 re the shell is 07a0: 73 68 20 6f 72 20 62 61 73 68 0a 3b 3b 20 22 66 sh or bash.;; "f 07b0: 69 6e 64 20 2f 20 2d 70 72 69 6e 74 20 32 26 3e ind / -print 2&> 07c0: 31 20 3e 20 66 69 6e 64 61 6c 6c 2e 6c 6f 67 22 1 > findall.log" 07d0: 0a 28 64 65 66 69 6e 65 20 28 72 75 6e 2d 6e 2d .(define (run-n- 07e0: 77 61 69 74 20 63 6d 64 6c 69 6e 65 29 0a 20 20 wait cmdline). 07f0: 28 6c 65 74 20 28 28 70 69 64 20 28 70 72 6f 63 (let ((pid (proc 0800: 65 73 73 2d 72 75 6e 20 63 6d 64 6c 69 6e 65 29 ess-run cmdline) 0810: 29 29 0a 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 )). (let loop 0820: 20 28 28 69 20 30 29 29 0a 20 20 20 20 20 20 28 ((i 0)). ( 0830: 6c 65 74 2d 76 61 6c 75 65 73 20 28 28 28 70 69 let-values (((pi 0840: 64 2d 76 61 6c 20 65 78 69 74 2d 73 74 61 74 75 d-val exit-statu 0850: 73 20 65 78 69 74 2d 63 6f 64 65 29 20 28 70 72 s exit-code) (pr 0860: 6f 63 65 73 73 2d 77 61 69 74 20 70 69 64 20 23 ocess-wait pid # 0870: 74 29 29 29 0a 20 20 20 20 20 20 20 20 20 28 69 t))). (i 0880: 66 20 28 65 71 3f 20 70 69 64 2d 76 61 6c 20 30 f (eq? pid-val 0 0890: 29 0a 09 20 20 20 20 20 28 62 65 67 69 6e 0a 09 ).. (begin.. 08a0: 20 20 20 20 20 20 20 28 74 68 72 65 61 64 2d 73 (thread-s 08b0: 6c 65 65 70 21 20 32 29 0a 09 20 20 20 20 20 20 leep! 2).. 08c0: 20 28 6c 6f 6f 70 20 28 2b 20 69 20 31 29 29 29 (loop (+ i 1))) 08d0: 0a 09 20 20 20 20 20 28 76 61 6c 75 65 73 20 70 .. (values p 08e0: 69 64 2d 76 61 6c 20 65 78 69 74 2d 73 74 61 74 id-val exit-stat 08f0: 75 73 20 65 78 69 74 2d 63 6f 64 65 29 29 29 29 us exit-code)))) 0900: 29 29 0a 20 20 )).