Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | Tests of the system of slots. |
|---|---|
| Downloads: | Tarball | ZIP archive |
| Timelines: | family | ancestors | descendants | both | development-slots |
| Files: | files | file ages | folders |
| SHA1: |
14aad12d58a4481fbdc0acf4ccc07d6a |
| User & Date: | dkf 2012-03-23 08:46:45.302 |
Context
|
2012-03-23
| ||
| 09:07 | Implementation of TIP #380 check-in: 0e25104bd8 user: dkf tags: trunk | |
| 08:46 | Tests of the system of slots. Closed-Leaf check-in: 14aad12d58 user: dkf tags: development-slots | |
|
2012-03-22
| ||
| 09:19 | Add documentation. Work towards better code organization. check-in: ea8879da76 user: dkf tags: development-slots | |
Changes
Changes to tests/oo.test.
| ︙ | ︙ | |||
2763 2764 2765 2766 2767 2768 2769 2770 2771 2772 2773 2774 2775 2776 |
oo::class create cls
} -body {
oo::define cls {constructor {} {my destroy}}
cls new
} -returnCodes error -cleanup {
cls destroy
} -result {object deleted in constructor}
cleanupTests
return
# Local Variables:
# mode: tcl
# End:
| > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 2763 2764 2765 2766 2767 2768 2769 2770 2771 2772 2773 2774 2775 2776 2777 2778 2779 2780 2781 2782 2783 2784 2785 2786 2787 2788 2789 2790 2791 2792 2793 2794 2795 2796 2797 2798 2799 2800 2801 2802 2803 2804 2805 2806 2807 2808 2809 2810 2811 2812 2813 2814 2815 2816 2817 2818 2819 2820 2821 2822 2823 2824 2825 2826 2827 2828 2829 2830 2831 2832 2833 2834 2835 2836 2837 2838 2839 2840 2841 2842 2843 2844 2845 2846 2847 2848 2849 2850 2851 2852 2853 2854 2855 2856 2857 2858 2859 2860 2861 2862 2863 2864 2865 2866 2867 2868 2869 2870 2871 2872 2873 2874 2875 2876 2877 2878 2879 2880 2881 2882 2883 2884 2885 2886 2887 2888 2889 2890 2891 2892 2893 2894 2895 2896 2897 2898 2899 2900 2901 2902 2903 2904 2905 2906 2907 2908 2909 2910 2911 2912 2913 2914 2915 2916 2917 2918 |
oo::class create cls
} -body {
oo::define cls {constructor {} {my destroy}}
cls new
} -returnCodes error -cleanup {
cls destroy
} -result {object deleted in constructor}
oo::class create SampleSlot {
superclass oo::Slot
constructor {} {
variable contents {a b c} ops {}
}
method contents {} {variable contents; return $contents}
method ops {} {variable ops; return $ops}
method Get {} {
variable contents
variable ops
lappend ops [info level] Get
return $contents
}
method Set {lst} {
variable contents $lst
variable ops
lappend ops [info level] Set $lst
return
}
}
test oo-31.1 {TIP 380: slots - class test} -setup {
SampleSlot create sampleSlot
} -body {
list [info level] [sampleSlot contents] [sampleSlot ops]
} -cleanup {
rename sampleSlot {}
} -result {0 {a b c} {}}
test oo-31.2 {TIP 380: slots - class test} -setup {
SampleSlot create sampleSlot
} -body {
list [info level] [sampleSlot -clear] \
[sampleSlot contents] [sampleSlot ops]
} -cleanup {
rename sampleSlot {}
} -result {0 {} {} {1 Set {}}}
test oo-31.3 {TIP 380: slots - class test} -setup {
SampleSlot create sampleSlot
} -body {
list [info level] [sampleSlot -append g h i] \
[sampleSlot contents] [sampleSlot ops]
} -cleanup {
rename sampleSlot {}
} -result {0 {} {a b c g h i} {1 Get 1 Set {a b c g h i}}}
test oo-31.4 {TIP 380: slots - class test} -setup {
SampleSlot create sampleSlot
} -body {
list [info level] [sampleSlot -set d e f] \
[sampleSlot contents] [sampleSlot ops]
} -cleanup {
rename sampleSlot {}
} -result {0 {} {d e f} {1 Set {d e f}}}
test oo-31.5 {TIP 380: slots - class test} -setup {
SampleSlot create sampleSlot
} -body {
list [info level] [sampleSlot -set d e f] [sampleSlot -append g h i] \
[sampleSlot contents] [sampleSlot ops]
} -cleanup {
rename sampleSlot {}
} -result {0 {} {} {d e f g h i} {1 Set {d e f} 1 Get 1 Set {d e f g h i}}}
test oo-32.1 {TIP 380: slots - defaulting} -setup {
set s [SampleSlot new]
} -body {
list [$s x y] [$s contents]
} -cleanup {
rename $s {}
} -result {{} {a b c x y}}
test oo-32.2 {TIP 380: slots - defaulting} -setup {
set s [SampleSlot new]
} -body {
list [$s destroy; $s unknown] [$s contents]
} -cleanup {
rename $s {}
} -result {{} {a b c destroy unknown}}
test oo-32.3 {TIP 380: slots - defaulting} -setup {
set s [SampleSlot new]
} -body {
oo::objdefine $s forward --default-operation my -set
list [$s destroy; $s unknown] [$s contents] [$s ops]
} -cleanup {
rename $s {}
} -result {{} unknown {1 Set destroy 1 Set unknown}}
test oo-32.4 {TIP 380: slots - errors} -setup {
set s [SampleSlot new]
} -body {
# Method names beginning with "-" are special to slots
$s -grill q
} -returnCodes error -cleanup {
rename $s {}
} -result {unknown method "-grill": must be -append, -clear, -set, contents or ops}
SampleSlot destroy
test oo-33.1 {TIP 380: slots - presence} -setup {
set obj [oo::object new]
set result {}
} -body {
oo::define oo::object {
::lappend ::result [::info object class filter]
::lappend ::result [::info object class mixin]
::lappend ::result [::info object class superclass]
::lappend ::result [::info object class variable]
}
oo::objdefine $obj {
::lappend ::result [::info object class filter]
::lappend ::result [::info object class mixin]
::lappend ::result [::info object class variable]
}
return $result
} -cleanup {
$obj destroy
} -result {::oo::Slot ::oo::Slot ::oo::Slot ::oo::Slot ::oo::Slot ::oo::Slot ::oo::Slot}
test oo-33.2 {TIP 380: slots - presence} {
lsort [info class instances oo::Slot]
} {::oo::define::filter ::oo::define::mixin ::oo::define::superclass ::oo::define::variable ::oo::objdefine::filter ::oo::objdefine::mixin ::oo::objdefine::variable}
proc getMethods obj {
list [lsort [info object methods $obj -all]] \
[lsort [info object methods $obj -private]]
}
test oo-33.3 {TIP 380: slots - presence} {
getMethods oo::define::filter
} {{-append -clear -set} {Get Set}}
test oo-33.4 {TIP 380: slots - presence} {
getMethods oo::define::mixin
} {{-append -clear -set} {--default-operation Get Set}}
test oo-33.5 {TIP 380: slots - presence} {
getMethods oo::define::superclass
} {{-append -clear -set} {--default-operation Get Set}}
test oo-33.6 {TIP 380: slots - presence} {
getMethods oo::define::variable
} {{-append -clear -set} {Get Set}}
test oo-33.7 {TIP 380: slots - presence} {
getMethods oo::objdefine::filter
} {{-append -clear -set} {Get Set}}
test oo-33.8 {TIP 380: slots - presence} {
getMethods oo::objdefine::mixin
} {{-append -clear -set} {--default-operation Get Set}}
test oo-33.9 {TIP 380: slots - presence} {
getMethods oo::objdefine::variable
} {{-append -clear -set} {Get Set}}
cleanupTests
return
# Local Variables:
# mode: tcl
# End:
|