1#!/usr/bin/perl -w
2use overload_simple;
3use vars qw/$DOWARN/;
4use strict;
5use Test::More tests => 97;
6
7pass("loaded");
8
9my $f = new overload_simple::Foo();
10isa_ok($f, "overload_simple::Foo");
11my $b = new overload_simple::Bar();
12isa_ok($b, "overload_simple::Bar");
13my $v = overload_simple::malloc_void(32);
14isa_ok($v, "_p_void");
15
16
17#
18# Silence warnings about bad types
19#
20BEGIN { $SIG{'__WARN__'} = sub { warn $_[0] if $DOWARN } }
21#
22#these tests should 'fail'
23#
24eval { overload_simple::fint("l") };
25ok($@, "fint(int) - int");
26
27eval { overload_simple::fint("3.5") };
28ok($@, "fint(int) - double");
29
30eval { overload_simple::fdouble("l") };
31ok($@, "fint(double) - int");
32
33eval { overload_simple::fdouble("1.5/2.0") };
34ok($@, "fint(double) - double");
35
36#
37#enable the warnings again
38#
39$DOWARN =1;
40
41#
42# 'simple' dispatch (no overload) of int and double arguments
43#
44
45is(overload_simple::fint(3), "fint:int", "fint(int) - int");
46
47is(overload_simple::fint("1"), "fint:int", "fint(int) - string int");
48
49is(overload_simple::fint(3.0), "fint:int", "fint(int) - double");
50
51is(overload_simple::fint("3.0"), "fint:int", "fint(int) - string double");
52
53# old bad case that now works
54my $n = 3;
55$n = $n + 1;
56is(overload_simple::fint($n), "fint:int", "fint(int) - int var");
57
58is(overload_simple::fint(4/2), "fint:int", "fint(int) - divide int denom");
59
60is(overload_simple::fint(4/2.0), "fint:int", "fint(int) - divide double denom");
61
62is(overload_simple::fdouble(3), "fdouble:double", "fdouble(double) - int");
63
64is(overload_simple::fdouble("3"), "fdouble:double", "fdouble(double) - string int");
65
66is(overload_simple::fdouble(3.0), "fdouble:double", "fdouble(double) - double");
67
68is(overload_simple::fdouble("3.0"), "fdouble:double", "fdouble(double) - string doubl");
69
70#
71# Overload between int and double
72#
73is(overload_simple::num(3), "num:int", "num(int) - int");
74
75is(overload_simple::num("3"), "num:int", "num(int) - string int");
76
77is(overload_simple::num(3.0), "num:double", "num(int) - double");
78
79is(overload_simple::num("3.0"), "num:double", "num(int) - string double");
80
81#
82# Overload between int, double, char * and many types.
83#
84is(overload_simple::foo(3), "foo:int", "foo:int - int");
85
86is(overload_simple::foo(3.0), "foo:double", "foo:double - double");
87
88is(overload_simple::foo("3"), "foo:char *", "foo:char * - string int");
89
90is(overload_simple::foo("3.0"), "foo:char *", "foo:char * - string double");
91
92is(overload_simple::foo("hello"), "foo:char *", "foo:char * string");
93
94is(overload_simple::foo($f), "foo:Foo *", "foo:Foo *");
95
96is(overload_simple::foo($b), "foo:Bar *", "foo:Bar *");
97
98is(overload_simple::foo($v), "foo:void *", "foo:void *");
99
100is(overload_simple::blah(3), "blah:double", "blah:double");
101
102is(overload_simple::blah("hello"), "blah:char *", "blah:char *");
103
104my $s = new overload_simple::Spam();
105
106is($s->foo(3), "foo:int", "Spam::foo:int");
107
108is($s->foo(3.0), "foo:double", "Spam::foo(double)");
109
110is($s->foo("hello"), "foo:char *", "Spam::foo:char *");
111
112is($s->foo($f), "foo:Foo *", "Spam::foo(Foo *)");
113
114is($s->foo($b), "foo:Bar *", "Spam::foo(Bar *)");
115
116is($s->foo($v), "foo:void *", "Spam::foo(void *)");
117
118is(overload_simple::Spam::bar(3), "bar:int", "Spam::bar(int)");
119
120is(overload_simple::Spam::bar(3.0), "bar:double", "Spam::bar(double)");
121
122is(overload_simple::Spam::bar("hello"), "bar:char *", "Spam::bar(char *)");
123
124is(overload_simple::Spam::bar($f), "bar:Foo *", "Spam::bar(Foo *)");
125
126is(overload_simple::Spam::bar($b), "bar:Bar *", "Spam::bar(Bar *)");
127
128is(overload_simple::Spam::bar($v), "bar:void *", "Spam::bar(void *)");
129
130# Test constructors
131
132$s = new overload_simple::Spam();
133isa_ok($s, "overload_simple::Spam");
134
135is($s->{type}, "none", "Spam()");
136
137$s = new overload_simple::Spam(3);
138isa_ok($s, "overload_simple::Spam");
139
140is($s->{type}, "int", "Spam(int)");
141
142$s = new overload_simple::Spam(3.0);
143isa_ok($s, "overload_simple::Spam");
144is($s->{type}, "double", "Spam(double)");
145
146$s = new overload_simple::Spam("hello");
147isa_ok($s, "overload_simple::Spam");
148is($s->{type}, "char *", "Spam(char *)");
149
150$s = new overload_simple::Spam($f);
151isa_ok($s, "overload_simple::Spam");
152is($s->{type}, "Foo *", "Spam(Foo *)");
153
154$s = new overload_simple::Spam($b);
155isa_ok($s, "overload_simple::Spam");
156is($s->{type}, "Bar *", "Spam(Bar *)");
157
158$s = new overload_simple::Spam($v);
159isa_ok($s, "overload_simple::Spam");
160is($s->{type}, "void *", "Spam(void *)");
161
162#
163# Combine dispatch
164#
165
166
167is(overload_simple::fid(3, 3.0), "fid:intdouble", "fid(int,double)");
168
169is(overload_simple::fid(3.0, 3), "fid:doubleint", "fid(double,int)");
170
171is(overload_simple::fid(3.0, 3.0), "fid:doubledouble", "fid(double,double)");
172
173is(overload_simple::fid(3, 3), "fid:intint", "fid(int,int)");
174
175# with strings now
176
177is(overload_simple::fid(3, "3.0"), "fid:intdouble", "fid(int,double)");
178
179is(overload_simple::fid("3", 3.0), "fid:intdouble", "fid(int,double)");
180
181is(overload_simple::fid("3", "3.0"), "fid:intdouble", "fid(int,double)");
182
183is(overload_simple::fid(3.0, "3"), "fid:doubleint", "fid(double,int)");
184
185is(overload_simple::fid("3.0", "3.0"), "fid:doubledouble", "fid:doubledouble");
186
187is(overload_simple::fid("3", 3), "fid:intint", "fid:fid(int,int)");
188
189isnt(overload_simple::fbool(0), overload_simple::fbool(1), "fbool(bool)");
190
191is(2, overload_simple::fbool(2), "fbool(int)");
192
193# int and object overload
194
195is(overload_simple::int_object(1), 1, "int_object(1)");
196is(overload_simple::int_object(0), 0, "int_object(0)");
197is(overload_simple::int_object(undef), 999, "int_object(Spam*)");
198is(overload_simple::int_object($s), 999, "int_object(Spam*)");
199
200# some of this section is duplication of above tests, but I want to see
201# parity with the coverage in wrapmacro_runme.pl.
202
203sub check {
204  my($args, $want) = @_;
205  my($s, $rslt) = defined $want ?  ($want, "bar:$want") : ('*boom*', undef);
206  is(eval("overload_simple::Spam::bar($args)"), $rslt, "bar($args) => $s");
207}
208
209# normal use patterns
210check("11", 'int');
211check("11.0", 'double');
212check("'11'", 'char *');
213check("'11.0'", 'char *');
214check("-13", 'int');
215check("-13.0", 'double');
216check("'-13'", 'char *');
217check("'-13.0'", 'char *');
218
219check("' '", 'char *');
220check("' 11 '", 'char *');
221# TypeError explosions
222check("\\*STDIN", undef);
223check("[]", undef);
224check("{}", undef);
225check("sub {}", undef);
226
227# regression cases
228check("''", 'char *');
229check("' 11'", 'char *');
230check("' 11.0'", 'char *');
231check("' -11.0'", 'char *');
232check("\"11\x{0}\"", 'char *');
233check("\"\x{0}\"", 'char *');
234check("\"\x{9}11\x{0}this is not eleven.\"", 'char *');
235check("\"\x{9}11.0\x{0}this is also not eleven.\"", 'char *');
236