diff --git a/collects/deinprogramm/define-record-procedures.rkt b/collects/deinprogramm/define-record-procedures.rkt index f4d20f511c..e0d0297d86 100644 --- a/collects/deinprogramm/define-record-procedures.rkt +++ b/collects/deinprogramm/define-record-procedures.rkt @@ -12,8 +12,7 @@ mzlib/pretty deinprogramm/signature/signature deinprogramm/signature/signature-german - deinprogramm/signature/signature-syntax - (only-in deinprogramm/quickcheck/quickcheck arbitrary-record)) + deinprogramm/signature/signature-syntax) (require (for-syntax scheme/base) (for-syntax deinprogramm/syntax-checkers) diff --git a/collects/deinprogramm/define-record-procedures.scm b/collects/deinprogramm/define-record-procedures.scm index dc7afb8fa3..6f6798cf01 100644 --- a/collects/deinprogramm/define-record-procedures.scm +++ b/collects/deinprogramm/define-record-procedures.scm @@ -183,17 +183,10 @@ component-signature ...))) ;; lazy signatures #'(define (?signature-constructor-name ?param ...) - (let* ((sigs (list ?param ...)) - (sig - (make-lazy-wrap-signature '?type-name #t - type-descriptor raw-predicate - sigs - #'?type-name))) - (let ((arbs (map signature-arbitrary sigs))) - (when (andmap values arbs) - (set-signature-arbitrary! sig - (apply arbitrary-record ?constructor arbs)))) - sig))) + (make-lazy-wrap-signature '?type-name #t + type-descriptor raw-predicate + (list ?param ...) + #'?type-name))) 'stepper-skip-completely #t))) #'(begin diff --git a/collects/deinprogramm/quickcheck/quickcheck.rkt b/collects/deinprogramm/quickcheck/quickcheck.rkt index a2e814275c..8e3c2f0a6f 100644 --- a/collects/deinprogramm/quickcheck/quickcheck.rkt +++ b/collects/deinprogramm/quickcheck/quickcheck.rkt @@ -12,7 +12,6 @@ arbitrary-mixed arbitrary-one-of arbitrary-pair arbitrary-list - arbitrary-tuple arbitrary-record arbitrary-vector arbitrary-string arbitrary-ascii-string arbitrary-printable-ascii-string diff --git a/collects/deinprogramm/quickcheck/quickcheck.scm b/collects/deinprogramm/quickcheck/quickcheck.scm index cf839a82f5..107a2be414 100644 --- a/collects/deinprogramm/quickcheck/quickcheck.scm +++ b/collects/deinprogramm/quickcheck/quickcheck.scm @@ -312,30 +312,20 @@ (coarbitrary arbitrary-cdr (cdr p) gen))))) -(define (make-tuple-transformer arbitrary-els) - (lambda (lis gen) - (let recur ((arbitrary-els arbitrary-els) - (lis lis)) - (if (null? arbitrary-els) - gen - ((arbitrary-transformer (car arbitrary-els)) - (car lis) - (recur (cdr arbitrary-els) - (cdr lis))))))) - ; a tuple is just a non-uniform list (define (arbitrary-tuple . arbitrary-els) (make-arbitrary (apply lift->generator list (map arbitrary-generator arbitrary-els)) - (make-tuple-transformer arbitrary-els))) - -; like a tuple, just with a different constructor -(define (arbitrary-record make . arbitrary-els) - (make-arbitrary (apply lift->generator - make - (map arbitrary-generator arbitrary-els)) - (make-tuple-transformer arbitrary-els))) + (lambda (lis gen) + (let recur ((arbitrary-els arbitrary-els) + (lis lis)) + (if (null? arbitrary-els) + gen + ((arbitrary-transformer (car arbitrary-els)) + (car lis) + (recur (cdr arbitrary-els) + (cdr lis)))))))) (define (arbitrary-sequence choose-sequence sequence->list arbitrary-el) (make-arbitrary (sized diff --git a/collects/deinprogramm/scribblings/DMdA-beginner.scrbl b/collects/deinprogramm/scribblings/DMdA-beginner.scrbl index 1ea03d1222..ce37b4da5a 100644 --- a/collects/deinprogramm/scribblings/DMdA-beginner.scrbl +++ b/collects/deinprogramm/scribblings/DMdA-beginner.scrbl @@ -291,10 +291,9 @@ Dieser Testfall überprüft experimentell, ob die @tech{Eigenschaft} @emph{Wichtig:} @scheme[check-property] funktioniert nur für Eigenschaften, bei denen aus den Signaturen sinnvoll Werte generiert werden können. Dies ist für die meisten eingebauten Signaturen der -Fall, aber nicht für Signaturvariablen und Signaturen, die mit @scheme[predicate] -oder @scheme[define-record-procedures] definiert -wurden - wohl aber für Signaturen, die mit dem durch @scheme[define-record-procedures-parametric] definierten -Signaturkonstruktor erzeugt wurden. +Fall, aber nicht für Signaturvariablen und Signaturen, die mit @scheme[predicate], +@scheme[property] oder @scheme[define-record-procedures] definiert +wurden. In diesen Fällen erzeugt @scheme[check-property] eine Fehlermeldung. } @section{Parametrische Record-Typ-Definitionen} diff --git a/collects/lang/private/teach.rkt b/collects/lang/private/teach.rkt index 4e383364c9..72b59545fd 100644 --- a/collects/lang/private/teach.rkt +++ b/collects/lang/private/teach.rkt @@ -894,18 +894,11 @@ (combined (at name_ (predicate raw-predicate)) (at field_ (signature:property getter-name field_/no-loc)) ...))) #`(define (#,parametric-signature-name field_ ...) - (let* ((sigs (list field_/no-loc ...)) - (sig - (make-lazy-wrap-signature 'name_ #t - type-descriptor - raw-predicate - sigs - #'name_))) - (let ((arbs (map signature-arbitrary sigs))) - (when (andmap values arbs) - (set-signature-arbitrary! sig - (apply arbitrary-record #,constructor-name arbs)))) - sig))) + (make-lazy-wrap-signature 'name_ #t + type-descriptor + raw-predicate + (list field_/no-loc ...) + #'name_))) (values #,signature-name #,parametric-signature-name proc-name ...))) 'stepper-define-struct-hint