suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Merge branch 'master' of git:plt

Browse Source
This commit is contained in:
Carl Eastlund 2010-05-10 16:39:24 -04:00
commit 93835460cb
9 changed files with 118 additions and 68 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

101
collects/meta/drdr/run-collect.ss
View File

@ -14,15 +14,6 @@
(list* cmd
args))))
(define (read-until-evt port-evt k)
(if port-evt
(handle-evt port-evt
(lambda (bs)
(if (eof-object? bs)
(k)
(k bs))))
never-evt))
(define (run/collect/wait
#:env env
#:timeout timeout
@ -40,7 +31,7 @@
(define-values
(the-process stdout stdin stderr)
(apply subprocess
#f #f #f
#f #f #f
new-command
new-args))
@ -49,48 +40,58 @@
; Run it without input
(close-output-port stdin)
; Wait for all the output, then the process death or timeout
; Wait for all the output and the process death or timeout
(local
[(define the-alarm
(alarm-evt (+ (current-inexact-milliseconds)
(* 1000 timeout))))
(define (slurp-output-evt loop stdout stderr log)
(choice-evt
(read-until-evt stdout
(case-lambda
[()
(loop #f stderr log)]
[(bs)
(loop stdout stderr (list* (make-stdout bs) log))]))
(read-until-evt stderr
(case-lambda
[()
(loop stdout #f log)]
[(bs)
(loop stdout stderr (list* (make-stderr bs) log))]))))
(define (finish-log stdout stderr log)
(if (or stdout stderr)
(sync (slurp-output-evt finish-log stdout stderr log))
(reverse log)))
(alarm-evt (+ start-time (* 1000 timeout))))
(define line-ch (make-channel))
(define (read-port-t make port)
(thread
(λ ()
(let loop ()
(define l (read-bytes-line port))
(if (eof-object? l)
(channel-put line-ch l)
(begin (channel-put line-ch (make l))
(loop)))))))
(define stdout-t (read-port-t make-stdout stdout))
(define stderr-t (read-port-t make-stderr stderr))
(define final-status
(let loop ([stdout (read-bytes-line-evt stdout)]
[stderr (read-bytes-line-evt stderr)]
(let loop ([open-ports 2]
[end-time #f]
[status #f]
[log empty])
(sync (handle-evt the-alarm
(lambda (_)
(define end-time
(current-inexact-milliseconds))
(subprocess-kill the-process #t)
(make-timeout start-time end-time command-line (finish-log stdout stderr log))))
(slurp-output-evt loop stdout stderr log)
(handle-evt the-process
(lambda (_)
(define end-time
(current-inexact-milliseconds))
(make-exit start-time end-time command-line
(finish-log stdout stderr log)
(subprocess-status the-process)))))))]
(define process-done? (and end-time #t))
(define output-done? (zero? open-ports))
(if (and output-done? process-done?)
(if status
(make-exit start-time end-time command-line (reverse log) status)
(make-timeout start-time end-time command-line (reverse log)))
(sync (if process-done?
never-evt
(choice-evt
(handle-evt the-alarm
(λ (_)
(define end-time
(current-inexact-milliseconds))
(subprocess-kill the-process #t)
(loop open-ports end-time status log)))
(handle-evt the-process
(λ (_)
(define end-time
(current-inexact-milliseconds))
(loop open-ports end-time (subprocess-status the-process) log)))))
(if output-done?
never-evt
(handle-evt line-ch
(match-lambda
[(? eof-object?)
(loop (sub1 open-ports) end-time status log)]
[l
(loop open-ports end-time status (list* l log))])))))))]
(close-input-port stdout)
(close-input-port stderr)
@ -140,6 +141,12 @@
(provide/contract
[command+args+env->command+args
(string? (listof string?) #:env (hash/c string? string?) . -> . (values string? (listof string?)))]
[run/collect/wait
(string?
#:env (hash/c string? string?)
#:timeout exact-nonnegative-integer?
(listof string?)
. -> . status?)]
[run/collect/wait/log
(path-string? string?
#:env (hash/c string? string?)

11
collects/meta/drdr/tests/loud.rkt Normal file
View File

@ -0,0 +1,11 @@
#lang racket
(define n (command-line #:args (n) (string->number n)))
(for ([i (in-range n)])
(fprintf (if (even? i)
(current-error-port)
(current-output-port))
"~a~n"
i))

32
collects/meta/drdr/tests/run-collect.rkt Normal file
View File

@ -0,0 +1,32 @@
#lang racket
(require "../run-collect.ss"
"../status.ss"
racket/runtime-path
tests/eli-tester)
(define-runtime-path loud-file "loud.rkt")
(define (run-loud n)
(run/collect/wait #:env (hash)
#:timeout (* 10)
(path->string (find-system-path 'exec-file))
(list "-t" (path->string loud-file)
"--" (number->string n))))
(define (test-run-loud n)
(test
#:failure-prefix (number->string n)
(status-output-log (run-loud n))
=>
(for/list ([i (in-range n)])
((if (even? i)
make-stderr
make-stdout)
(string->bytes/utf-8
(number->string i))))))
(test
(for ([n (in-range 10)])
(test-run-loud n)))
(run-loud 10)

2
src/worksp/gracket/gracket.manifest
View File

@ -1,7 +1,7 @@
<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">
<assemblyIdentity
version="4.2.5.10"
version="4.2.5.14"
processorArchitecture="X86"
name="Org.PLT-Scheme.GRacket"
type="win32"

8
src/worksp/gracket/gracket.rc
View File

@ -20,8 +20,8 @@ APPLICATION ICON DISCARDABLE "gracket.ico"
//
VS_VERSION_INFO VERSIONINFO
FILEVERSION 4,2,5,10
PRODUCTVERSION 4,2,5,10
FILEVERSION 4,2,5,14
PRODUCTVERSION 4,2,5,14
FILEFLAGSMASK 0x3fL
#ifdef _DEBUG
FILEFLAGS 0x1L
@ -39,11 +39,11 @@ BEGIN
VALUE "CompanyName", "PLT Scheme Inc.\0"
VALUE "FileDescription", "Racket GUI application\0"
VALUE "InternalName", "GRacket\0"
VALUE "FileVersion", "4, 2, 5, 10\0"
VALUE "FileVersion", "4, 2, 5, 14\0"
VALUE "LegalCopyright", "Copyright © 1995-2010\0"
VALUE "OriginalFilename", "GRacket.exe\0"
VALUE "ProductName", "Racket\0"
VALUE "ProductVersion", "4, 2, 5, 10\0"
VALUE "ProductVersion", "4, 2, 5, 14\0"
END
END
BLOCK "VarFileInfo"

10
src/worksp/mzcom/mzcom.rc
View File

@ -53,8 +53,8 @@ END
//
VS_VERSION_INFO VERSIONINFO
FILEVERSION 4,2,5,10
PRODUCTVERSION 4,2,5,10
FILEVERSION 4,2,5,14
PRODUCTVERSION 4,2,5,14
FILEFLAGSMASK 0x3fL
#ifdef _DEBUG
FILEFLAGS 0x1L
@ -70,12 +70,12 @@ BEGIN
BLOCK "040904b0"
BEGIN
VALUE "FileDescription", "MzCOM Module"
VALUE "FileVersion", "4, 2, 5, 10"
VALUE "FileVersion", "4, 2, 5, 14"
VALUE "InternalName", "MzCOM"
VALUE "LegalCopyright", "Copyright 2000-2010 PLT (Paul Steckler)"
VALUE "OriginalFilename", "MzCOM.EXE"
VALUE "ProductName", "MzCOM Module"
VALUE "ProductVersion", "4, 2, 5, 10"
VALUE "ProductVersion", "4, 2, 5, 14"
END
END
BLOCK "VarFileInfo"
@ -108,7 +108,7 @@ BEGIN
CTEXT "MzCOM v. 4.2",IDC_STATIC,71,8,61,8
CTEXT "Copyright (c) 2000-2010 PLT (Paul Steckler)",IDC_STATIC,
41,20,146,9
CTEXT "MzScheme v. 4.2",IDC_STATIC,64,35,75,8
CTEXT "Racket v. 4.2",IDC_STATIC,64,35,75,8
CTEXT "Copyright (c) 1995-2010 PLT Inc.",IDC_STATIC,
30,47,143,8
ICON MZICON,IDC_STATIC,11,16,20,20

6
src/worksp/mzcom/mzobj.rgs
View File

@ -1,19 +1,19 @@
HKCR
{
MzCOM.MzObj.4.2.5.10 = s 'MzObj Class'
MzCOM.MzObj.4.2.5.14 = s 'MzObj Class'
{
CLSID = s '{A3B0AF9E-2AB0-11D4-B6D2-0060089002FE}'
}
MzCOM.MzObj = s 'MzObj Class'
{
CLSID = s '{A3B0AF9E-2AB0-11D4-B6D2-0060089002FE}'
CurVer = s 'MzCOM.MzObj.4.2.5.10'
CurVer = s 'MzCOM.MzObj.4.2.5.14'
}
NoRemove CLSID
{
ForceRemove {A3B0AF9E-2AB0-11D4-B6D2-0060089002FE} = s 'MzObj Class'
{
ProgID = s 'MzCOM.MzObj.4.2.5.10'
ProgID = s 'MzCOM.MzObj.4.2.5.14'
VersionIndependentProgID = s 'MzCOM.MzObj'
ForceRemove 'Programmable'
LocalServer32 = s '%MODULE%'

8
src/worksp/racket/racket.rc
View File

@ -29,8 +29,8 @@ APPLICATION ICON DISCARDABLE "racket.ico"
//
VS_VERSION_INFO VERSIONINFO
FILEVERSION 4,2,5,10
PRODUCTVERSION 4,2,5,10
FILEVERSION 4,2,5,14
PRODUCTVERSION 4,2,5,14
FILEFLAGSMASK 0x3fL
#ifdef _DEBUG
FILEFLAGS 0x1L
@ -48,11 +48,11 @@ BEGIN
VALUE "CompanyName", "PLT Scheme Inc.\0"
VALUE "FileDescription", "Racket application\0"
VALUE "InternalName", "Racket\0"
VALUE "FileVersion", "4, 2, 5, 10\0"
VALUE "FileVersion", "4, 2, 5, 14\0"
VALUE "LegalCopyright", "Copyright <20>© 1995-2010\0"
VALUE "OriginalFilename", "racket.exe\0"
VALUE "ProductName", "Racket\0"
VALUE "ProductVersion", "4, 2, 5, 10\0"
VALUE "ProductVersion", "4, 2, 5, 14\0"
END
END
BLOCK "VarFileInfo"

8
src/worksp/starters/start.rc
View File

@ -22,8 +22,8 @@ APPLICATION ICON DISCARDABLE "mzstart.ico"
//
VS_VERSION_INFO VERSIONINFO
FILEVERSION 4,2,5,10
PRODUCTVERSION 4,2,5,10
FILEVERSION 4,2,5,14
PRODUCTVERSION 4,2,5,14
FILEFLAGSMASK 0x3fL
#ifdef _DEBUG
FILEFLAGS 0x1L
@ -45,7 +45,7 @@ BEGIN
#ifdef MZSTART
VALUE "FileDescription", "Racket Launcher\0"
#endif
VALUE "FileVersion", "4, 2, 5, 10\0"
VALUE "FileVersion", "4, 2, 5, 14\0"
#ifdef MRSTART
VALUE "InternalName", "mrstart\0"
#endif
@ -60,7 +60,7 @@ BEGIN
VALUE "OriginalFilename", "MzStart.exe\0"
#endif
VALUE "ProductName", "Racket\0"
VALUE "ProductVersion", "4, 2, 5, 10\0"
VALUE "ProductVersion", "4, 2, 5, 14\0"
END
END
BLOCK "VarFileInfo"