1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153
|
"======================================================================
|
| Tests for the TwistedPools (3.1+) pool resolution strategy
|
|
======================================================================"
"======================================================================
|
| Copyright (C) 2008 Free Software Foundation, Inc.
| Written by Stephen Compall.
|
| This file is part of the GNU Smalltalk class library.
|
| The GNU Smalltalk class library is free software; you can redistribute it
| and/or modify it under the terms of the GNU Lesser General Public License
| as published by the Free Software Foundation; either version 2.1, or (at
| your option) any later version.
|
| The GNU Smalltalk class library is distributed in the hope that it will be
| useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
| MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser
| General Public License for more details.
|
| You should have received a copy of the GNU Lesser General Public License
| along with the GNU Smalltalk class library; see the file COPYING.LIB.
| If not, write to the Free Software Foundation, 59 Temple Place - Suite
| 330, Boston, MA 02110-1301, USA.
|
======================================================================"
Smalltalk addSubspace: #MyLibrary; addSubspace: #MyProject; addSubspace: #MyImports.
MyProject addSubspace: #MyLibWrapper.
"actually for later, to demonstrate the need for the `direct
superclass only' namespace-walk-stop rule"
MyLibrary at: #PkgVersion put: 'MyLibrary 1.0'.
MyProject at: #PkgVersion put: 'MyProject 0.3141'.
Namespace current: MyLibrary [
MyLibrary at: #StandardOverrides put:
(Dictionary from: {#Scape -> 42});
at: #ValueAdaptor put: 9994;
yourself.
Object subclass: Foo [
Exception := 42.
Scape := 21.
exception [^Exception]
scape [^Scape]
]
Foo subclass: Bar [
<import: StandardOverrides>
scape [^Scape]
valueAdaptor [^ValueAdaptor]
]
Bar subclass: Blah [
scape [^Scape]
]
] "end namespace MyLibrary"
Namespace current: MyProject.MyLibWrapper [
Namespace current import:
(Dictionary from: {#Blah -> 6667. #Scoobs -> 785}).
"note this changes my superspace"
MyProject at: #Exception put: #Exception.
MyLibrary.Foo subclass: Baz [
scape [^Scape]
exception [^Exception]
valueAdaptor [^ValueAdaptor]
blah [^Blah]
]
] "end namespace MyProject.MyLibWrapper"
Namespace current: MyLibrary [
"you ask, Who would do this? to which I say..."
MyProject.MyLibWrapper.Baz subclass: BackForMore [
pkgVersion [^PkgVersion]
blah [^Blah]
scoobs [^Scoobs]
]
] "end namespace MyLibrary"
Namespace current: MyImports [
<import: MyLibrary>
Object subclass: MITest [
test [^Foo]
]
<import: MyProject.MyLibWrapper>
MITest extend [
test2 [^Baz]
]
]
"here start the tests..."
"prefer class pool to namespace"
MyLibrary.Foo class extend [ test [ ^Exception ] ]
Eval [ MyLibrary.Foo test ] "42"
"prefer shared pool to super-class pool"
MyLibrary.Bar class extend [ test [ ^Scape ] ]
Eval [ MyLibrary.Bar test ] "42"
"test inherited pools: super-shared pool"
MyLibrary.Blah class extend [ test [ ^Scape ] ]
Eval [ MyLibrary.Blah test ] "42"
"test inherited pools: super-class pool"
MyProject.MyLibWrapper.Baz class extend [ test [ ^Scape ] ]
Eval [ MyProject.MyLibWrapper.Baz test ] "21"
"test namespace walk"
MyProject.MyLibWrapper.Baz class extend [ test [ ^Exception ] ]
Eval [ MyProject.MyLibWrapper.Baz test ] "#Exception"
MyProject.MyLibWrapper.Baz class extend [ test [ ^ValueAdaptor ] ]
Eval [ MyProject.MyLibWrapper.Baz test ] "9994"
MyLibrary.BackForMore class extend [ test [ ^PkgVersion ] ]
Eval [ MyLibrary.BackForMore test ] "'MyLibrary 1.0'"
"These do not work yet:
MyLibrary.Foo class extend [ TryThis := ##(Exception printNl) ]
MyLibrary.Bar class extend [ TryThis := ##(Scape printNl) ]
MyLibrary.Blah class extend [ TryThis := ##(Scape printNl) ]
MyProject.MyLibWrapper.Baz class extend [ TryThis := ##(Scape printNl) ]
MyProject.MyLibWrapper.Baz class extend [ TryThis := ##(Exception printNl) ]
MyProject.MyLibWrapper.Baz class extend [ TryThis := ##(ValueAdaptor printNl) ]
MyLibrary.BackForMore class extend [ TryThis := ##(PkgVersion printNl) ]"
"test namespace-sharedpools"
Eval [ MyProject.MyLibWrapper.Baz new blah ] "6667"
Eval [ MyLibrary.BackForMore new blah ] "Blah"
Eval [ MyLibrary.BackForMore new scoobs ] "785"
"test namespace pragmas"
Eval [ MyImports.MITest new test nameIn: Smalltalk ] "MyLibrary.Foo"
Eval [ MyImports.MITest new test2 nameIn: Smalltalk ] "MyProject.MyLibWrapper.Baz"
|