fix tests for the "class:"-less object-name results

This commit is contained in:
Robby Findler 2012-12-22 18:25:43 -06:00
parent b112a7ef0a
commit 58e15cc2c7
3 changed files with 10 additions and 10 deletions

View File

@ -4181,17 +4181,17 @@ so that propagation occurs.
(test-name '(one-of/c '() 'x 1 #f #\a (void) (letrec ([x x]) x))
(one-of/c '() 'x 1 #f #\a (void) (letrec ([x x]) x)))
(test-name '(subclass?/c class:c%)
(test-name '(subclass?/c c%)
(let ([c% (class object% (super-new))]) (subclass?/c c%)))
(test-name '(implementation?/c interface:i<%>)
(test-name '(implementation?/c i<%>)
(let ([i<%> (interface ())])
(implementation?/c i<%>)))
(test-name '(is-a?/c interface:i<%>)
(test-name '(is-a?/c i<%>)
(let ([i<%> (interface ())])
(is-a?/c i<%>)))
(test-name '(is-a?/c class:c%)
(test-name '(is-a?/c c%)
(let ([i<%> (interface ())]
[c% (class object% (super-new))])
(is-a?/c c%)))

View File

@ -12114,17 +12114,17 @@ so that propagation occurs.
(test-name '(or/c #f #t #\a "x") (or/c #f #t #\a "x"))
(test-name '(or/c #f #t #\a "x" #rx"x" #rx#"x") (or/c #f #t #\a "x" #rx"x" #rx#"x"))
(test-name '(subclass?/c class:c%)
(test-name '(subclass?/c c%)
(let ([c% (class object% (super-new))]) (subclass?/c c%)))
(test-name '(implementation?/c interface:i<%>)
(test-name '(implementation?/c i<%>)
(let ([i<%> (interface ())])
(implementation?/c i<%>)))
(test-name '(is-a?/c interface:i<%>)
(test-name '(is-a?/c i<%>)
(let ([i<%> (interface ())])
(is-a?/c i<%>)))
(test-name '(is-a?/c class:c%)
(test-name '(is-a?/c c%)
(let ([i<%> (interface ())]
[c% (class object% (super-new))])
(is-a?/c c%)))

View File

@ -73,8 +73,8 @@
(test #t src-name? (object-name (interface ())))
; Test class stuff ok when name
(test 'class:c1 object-name (let ([c1 (class object% (super-make-object))]) c1))
(test 'interface:i1 object-name (let ([i1 (interface ())]) i1))
(test 'c1 object-name (let ([c1 (class object% (super-make-object))]) c1))
(test 'i1 object-name (let ([i1 (interface ())]) i1))
; Test unit stuff ok when no name
(test #t src-name? (object-name (unit (import) (export))))