From 98b9a6277581aefe753ab0eba7c9700d3b8446c0 Mon Sep 17 00:00:00 2001 From: Ryan Culpepper Date: Fri, 23 Jan 2009 15:13:49 +0000 Subject: [PATCH] stxclass: fixed build bug, fixed tests svn: r13265 --- collects/stxclass/private/rep.ss | 19 ++++++++++--------- collects/tests/stxclass/stxclass.ss | 1 + 2 files changed, 11 insertions(+), 9 deletions(-) diff --git a/collects/stxclass/private/rep.ss b/collects/stxclass/private/rep.ss index c811c7a630..368c4d0150 100644 --- a/collects/stxclass/private/rep.ss +++ b/collects/stxclass/private/rep.ss @@ -187,15 +187,16 @@ (values id sc null (ssc? sc))))] [(decls id0) => (lambda (p) - (let ([stxclass (car p)] - [args (cdr p)]) - (unless (equal? (length (sc-inputs stxclass)) (length args)) - (raise-syntax-error 'syntax-class - (format "too few arguments for syntax class ~a (expected ~s)" - (sc-name stxclass) - (length (sc-inputs stxclass))) - id0)) - (values id0 stxclass args (ssc? stxclass))))] + (define scname (cadr p)) + (define args (cddr p)) + (define stxclass (get-stxclass scname)) + (unless (equal? (length (sc-inputs stxclass)) (length args)) + (raise-syntax-error 'syntax-class + (format "too few arguments for syntax class ~a (expected ~s)" + (sc-name stxclass) + (length (sc-inputs stxclass))) + id0)) + (values id0 stxclass args (ssc? stxclass)))] [else (values id0 #f null #f)])) (define (atomic-datum? stx) diff --git a/collects/tests/stxclass/stxclass.ss b/collects/tests/stxclass/stxclass.ss index 9a999008ee..96e8c33f40 100644 --- a/collects/tests/stxclass/stxclass.ss +++ b/collects/tests/stxclass/stxclass.ss @@ -3,6 +3,7 @@ (require (planet "test.ss" ("schematics" "schemeunit.plt" 2 9)) (planet "graphical-ui.ss" ("schematics" "schemeunit.plt" 2 9)) stxclass + stxclass/private/sc (for-syntax scheme/base stxclass)) ;; Testing stuff