blob: 6b5b67e4a26235af410a7cef5293a92669388a02 (
plain)
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
|
Dim vp
Set vp = WScript.CreateObject("virtual_poly.virtual_poly")
Dim d, i
Set d = vp.NDouble.new_NDouble(3.5)
Set i = vp.NInt.new_NInt(2)
Rem We are using IDispatch/OLE Automation - no downcast should be needed
Rem for covariant functions
Dim dc, ic
Set dc = d.copy()
Set ic = i.copy()
Dim ddc, dic
Set ddc = vp.NDouble.narrow(dc)
Set dic = vp.NInt.narrow(ic)
Rem This fails, probably due to a bug in memory management code
Set dc = ddc
Set ic = dic
vp.incr(dic)
If (i.get() + 1) <> ic.get() Then
WScript.Echo "incr test failed"
WScript.Quit(1)
End If
Rem Checking a pure user downcast
Dim n1, n2, dn1, dn2
Set n1 = d.copy()
Set n2 = d.nnumber()
Set dn1 = vp.NDouble.narrow(n1)
Set dn2 = vp.NDouble.narrow(n2)
If dn1.get() <> dn2.get() Then
WScript.Echo "copy/narrow test failed"
WScript.Quit(1)
End If
Rem Checking the ref polymorphic case
Dim nr, dr1, dr2
Set nr = d.ref_this()
Set dr1 = vp.NDouble.narrow(nr)
Set dr2 = d.ref_this()
If dr1.get() <> dr2.get() Then
WScript.Echo "copy/narrow test failed"
WScript.Quit(1)
End If
|