diff options
| -rw-r--r-- | SAHP.internal-common.scm | 8 | ||||
| -rw-r--r-- | tests/run.scm | 16 |
2 files changed, 20 insertions, 4 deletions
diff --git a/SAHP.internal-common.scm b/SAHP.internal-common.scm index b93cee1..9030c7c 100644 --- a/SAHP.internal-common.scm +++ b/SAHP.internal-common.scm @@ -80,11 +80,11 @@ (if (SAHP-entry? entry) (SAHP-entry-inherited? entry) #t))) - (define (recurse-on-subtype subtype) + (define (recurse-on-subtype type) (when (empty-or-inherited? type) - (hash-table-set! table type (make-SAHP-entry value #f)) - (for-each recurse-on-subtype (subtypes subtype)))) - (hash-table-set! table type (make-SAHP-entry value #t)) + (hash-table-set! table type (make-SAHP-entry value #t)) + (for-each recurse-on-subtype (subtypes type)))) + (hash-table-set! table type (make-SAHP-entry value #f)) (for-each recurse-on-subtype (subtypes type))) (define (%SAHP-set/subtypes scope types values) diff --git a/tests/run.scm b/tests/run.scm index 392dac6..9825c30 100644 --- a/tests/run.scm +++ b/tests/run.scm @@ -194,4 +194,20 @@ (letrec-SAHP ((sub ('rational (lambda (x) 2)))) (test-equal 2 (sub 0)) (test-equal 2 (sub 1/2)) + (test-equal 1 (sub 1+2i)))))) + (test-group "global scope" + (define-global-SAHP (sub ('number x)) + 1) + (test-group "subtypes flow downwards" + (test-for-all)) + (test-group "dynamic scope overrides global scope" + (parameterize-SAHP ((sub ('rational (lambda (x) 2)))) + (test-equal 2 (sub 0)) + (test-equal 2 (sub 1/2)) + (test-equal 1 (sub 1+2i)))) + (test-group "local scope overrides dynamic scope overrides global scope" + (parameterize-SAHP ((sub ('rational (lambda (x) 2)))) + (letrec-SAHP ((sub ('integer (lambda (x) 3)))) + (test-equal 3 (sub 0)) + (test-equal 2 (sub 1/2)) (test-equal 1 (sub 1+2i))))))) |