c0b928c758
if there already was one that I didn't find). Also fixed syntax error raising procedure. closes PR 12859
61 lines
1.6 KiB
Racket
61 lines
1.6 KiB
Racket
#lang at-exp racket/base
|
|
(require algol60/algol60
|
|
rackunit
|
|
(for-syntax racket/base))
|
|
|
|
(define-syntax (capture-output stx)
|
|
(syntax-case stx ()
|
|
[(_ exp)
|
|
(with-handlers ((exn:fail?
|
|
(λ (exn)
|
|
#`(list 'expand
|
|
#,(exn-message exn)))))
|
|
(define expanded (local-expand #'exp 'expression #f))
|
|
#`(let ([op (open-output-string)]
|
|
[ep (open-output-string)])
|
|
(let/ec k
|
|
(parameterize ([current-output-port op]
|
|
[current-error-port ep]
|
|
[error-escape-handler (λ () (k (void)))])
|
|
#,expanded))
|
|
(list 'run
|
|
(get-output-string op)
|
|
(get-output-string ep))))]))
|
|
|
|
(check-equal?
|
|
(capture-output
|
|
@literal-algol{
|
|
begin
|
|
printsln (`hello world')
|
|
end
|
|
})
|
|
'(run "hello world\n" ""))
|
|
|
|
(check-pred
|
|
(λ (x) (and (eq? (list-ref x 0) 'expand)
|
|
(regexp-match #rx"parse error near BEGIN"
|
|
(list-ref x 1))))
|
|
(capture-output
|
|
@literal-algol{
|
|
begin
|
|
}))
|
|
|
|
|
|
(check-pred
|
|
(λ (x) (and (eq? (list-ref x 0) 'expand)
|
|
(regexp-match #rx"parse error near PROCEDURE"
|
|
(list-ref x 1))))
|
|
(capture-output
|
|
@literal-algol{
|
|
procedure Absmax(a) Size:(n, m) Result:(y) Subscripts:(i, k);
|
|
value n, m; array a; integer n, m, i, k; real y;
|
|
begin integer p, q;
|
|
y := 0; i := k := 1;
|
|
for p:=1 step 1 until n do
|
|
for q:=1 step 1 until m do
|
|
if abs(a[p, q]) > y then
|
|
begin y := abs(a[p, q]);
|
|
i := p; k := q
|
|
end
|
|
end Absmax}))
|