summaryrefslogtreecommitdiff
path: root/Examples/test-suite/com/virtual_poly_runme.vbs
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