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