several testcases for perl
git-svn-id: https://swig.svn.sourceforge.net/svnroot/swig/trunk@10403 626c5289-ae23-0410-ae9c-e8d60b6d4f22
This commit is contained in:
Robert Stone
parent
ef7c0cbbd2
commit
8b713d759d
53 changed files with 2037 additions and 486 deletions
|
|
@ -15,3 +15,18 @@ Currently converted test cases include:
|
|||
* operator_overload_break
|
||||
* package
|
||||
* overload_simple
|
||||
* apply_strings
|
||||
* char_strings
|
||||
* default_args
|
||||
* enum_thorough
|
||||
* global_vars
|
||||
* import_nomodule
|
||||
* inherit
|
||||
* li_cdata_carrays
|
||||
* li_std_string
|
||||
* member_pointer
|
||||
* multiple_inheritance
|
||||
* primitive_ref
|
||||
* template_default_arg
|
||||
* unions
|
||||
* voidtest
|
||||
|
|
|
|||
22
Examples/test-suite/perl5/aggregate_runme.pl
Normal file
22
Examples/test-suite/perl5/aggregate_runme.pl
Normal file
|
|
@ -0,0 +1,22 @@
|
|||
#!/usr/bin/perl
|
||||
use strict;
|
||||
use warnings;
|
||||
use Test::More tests => 7;
|
||||
BEGIN { use_ok('aggregate') }
|
||||
require_ok('aggregate');
|
||||
|
||||
# adapted from ../java/aggregate_runme.java
|
||||
|
||||
# Confirm that move() returns correct results under normal use
|
||||
is(aggregate::move($aggregate::UP), $aggregate::UP, "UP");
|
||||
|
||||
is(aggregate::move($aggregate::DOWN), $aggregate::DOWN, "DOWN");
|
||||
|
||||
is(aggregate::move($aggregate::LEFT), $aggregate::LEFT, "LEFT");
|
||||
|
||||
is(aggregate::move($aggregate::RIGHT), $aggregate::RIGHT, "RIGHT");
|
||||
|
||||
# Confirm that move() raises an exception when the contract is violated
|
||||
eval { aggregate::move(0) };
|
||||
like($@, qr/\bRuntimeError\b/);
|
||||
|
||||
26
Examples/test-suite/perl5/apply_signed_char_runme.pl
Normal file
26
Examples/test-suite/perl5/apply_signed_char_runme.pl
Normal file
|
|
@ -0,0 +1,26 @@
|
|||
#!/usr/bin/perl
|
||||
use strict;
|
||||
use warnings;
|
||||
use Test::More tests => 12;
|
||||
BEGIN { use_ok('apply_signed_char') }
|
||||
require_ok('apply_signed_char');
|
||||
|
||||
# adapted from ../java/apply_signed_char_runme.java
|
||||
|
||||
my $smallnum = -127;
|
||||
is(apply_signed_char::CharValFunction($smallnum), $smallnum);
|
||||
is(apply_signed_char::CCharValFunction($smallnum), $smallnum);
|
||||
is(apply_signed_char::CCharRefFunction($smallnum), $smallnum);
|
||||
|
||||
$apply_signed_char::globalchar = $smallnum;
|
||||
is($apply_signed_char::globalchar, $smallnum);
|
||||
is($apply_signed_char::globalconstchar, -110);
|
||||
|
||||
my $d = new apply_signed_char::DirectorTest();
|
||||
is($d->CharValFunction($smallnum), $smallnum);
|
||||
is($d->CCharValFunction($smallnum), $smallnum);
|
||||
is($d->CCharRefFunction($smallnum), $smallnum);
|
||||
|
||||
$d->{memberchar} = $smallnum;
|
||||
is($d->{memberchar}, $smallnum);
|
||||
is($d->{memberconstchar}, -112);
|
||||
|
|
@ -1,10 +1,11 @@
|
|||
use apply_strings;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Test::More tests => 4;
|
||||
BEGIN { use_ok('apply_strings') }
|
||||
require_ok('apply_strings');
|
||||
|
||||
my $TEST_MESSAGE = "A message from target language to the C++ world and back again.";
|
||||
|
||||
if (apply_strings::UCharFunction($TEST_MESSAGE) ne $TEST_MESSAGE) {
|
||||
die "UCharFunction failed";
|
||||
}
|
||||
if (apply_strings::SCharFunction($TEST_MESSAGE) ne $TEST_MESSAGE) {
|
||||
die "SCharFunction failed";
|
||||
}
|
||||
is(apply_strings::UCharFunction($TEST_MESSAGE), $TEST_MESSAGE, "UCharFunction");
|
||||
|
||||
is(apply_strings::SCharFunction($TEST_MESSAGE), $TEST_MESSAGE, "SCharFunction");
|
||||
|
|
|
|||
28
Examples/test-suite/perl5/array_member_runme.pl
Normal file
28
Examples/test-suite/perl5/array_member_runme.pl
Normal file
|
|
@ -0,0 +1,28 @@
|
|||
#!/usr/bin/perl
|
||||
use strict;
|
||||
use warnings;
|
||||
use Test::More tests => 18;
|
||||
BEGIN { use_ok('array_member') }
|
||||
require_ok('array_member');
|
||||
|
||||
my $f = array_member::Foo->new();
|
||||
$f->{data} = $array_member::global_data;
|
||||
|
||||
for(my $i=0; $i<8; $i++) {
|
||||
is( array_member::get_value($f->{data},$i),
|
||||
array_member::get_value($array_member::global_data,$i),
|
||||
"array assignment");
|
||||
}
|
||||
|
||||
for(my $i=0; $i<8; $i++) {
|
||||
array_member::set_value($f->{data},$i,-$i);
|
||||
}
|
||||
|
||||
$array_member::global_data = $f->{data};
|
||||
|
||||
for(my $i=0; $i<8; $i++) {
|
||||
is(array_member::get_value($f->{data},$i),
|
||||
array_member::get_value($array_member::global_data,$i),
|
||||
"array assignment");
|
||||
}
|
||||
|
||||
|
|
@ -1,12 +1,12 @@
|
|||
use char_strings;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Test::More tests => 4;
|
||||
BEGIN { use_ok('char_strings') }
|
||||
require_ok('char_strings');
|
||||
|
||||
my $val1 = "100";
|
||||
if (char_strings::CharPingPong($val1) != "100") {
|
||||
die "failed";
|
||||
}
|
||||
is(char_strings::CharPingPong($val1), "100", 'cstr1');
|
||||
|
||||
my $val2 = "greetings";
|
||||
if (char_strings::CharPingPong($val2) != "greetings") {
|
||||
die "failed";
|
||||
}
|
||||
is(char_strings::CharPingPong($val2), "greetings", 'cstr2');
|
||||
|
||||
|
|
|
|||
12
Examples/test-suite/perl5/class_ignore_runme.pl
Executable file
12
Examples/test-suite/perl5/class_ignore_runme.pl
Executable file
|
|
@ -0,0 +1,12 @@
|
|||
#!/usr/bin/perl
|
||||
use strict;
|
||||
use warnings;
|
||||
use Test::More tests => 3;
|
||||
BEGIN { use_ok('class_ignore') }
|
||||
require_ok('class_ignore');
|
||||
|
||||
# adapted from ../python/class_ignore_runme.py
|
||||
|
||||
my $a = class_ignore::Bar->new();
|
||||
|
||||
is(class_ignore::do_blah($a), "Bar::blah");
|
||||
78
Examples/test-suite/perl5/contract_runme.pl
Executable file
78
Examples/test-suite/perl5/contract_runme.pl
Executable file
|
|
@ -0,0 +1,78 @@
|
|||
#!/usr/bin/perl
|
||||
use strict;
|
||||
use warnings;
|
||||
use Test::More tests => 32;
|
||||
BEGIN { use_ok('contract') }
|
||||
require_ok('contract');
|
||||
|
||||
# adapted from ../python/contract_runme.py
|
||||
{
|
||||
ok(contract::test_preassert(1,2), "good preassertion");
|
||||
eval { contract::test_preassert(-1) };
|
||||
like($@, qr/\bRuntimeError\b/, "bad preassertion");
|
||||
|
||||
ok(contract::test_postassert(3), "good postassertion");
|
||||
eval { contract::test_postassert(-3) };
|
||||
like($@, qr/\bRuntimeError\b/, "bad postassertion");
|
||||
|
||||
ok(contract::test_prepost(2,3), "good prepost");
|
||||
ok(contract::test_prepost(5,-4), "good prepost");
|
||||
eval { contract::test_prepost(-3,4); };
|
||||
like($@, qr/\bRuntimeError\b/, "bad preassertion");
|
||||
eval { contract::test_prepost(4,-10) };
|
||||
like($@, qr/\bRuntimeError\b/, "bad postassertion");
|
||||
}
|
||||
{
|
||||
my $f = contract::Foo->new();
|
||||
ok($f->test_preassert(4,5), "method pre");
|
||||
eval { $f->test_preassert(-2,3) };
|
||||
like($@, qr/\bRuntimeError\b/, "method pre bad");
|
||||
|
||||
ok($f->test_postassert(4), "method post");
|
||||
eval { $f->test_postassert(-4) };
|
||||
like($@, qr/\bRuntimeError\b/, "method post bad");
|
||||
|
||||
ok($f->test_prepost(3,4), "method prepost");
|
||||
ok($f->test_prepost(4,-3), "method prepost");
|
||||
eval { $f->test_prepost(-4,2) };
|
||||
like($@, qr/\bRuntimeError\b/, "method pre bad");
|
||||
eval { $f->test_prepost(4,-10) };
|
||||
like($@, qr/\bRuntimeError\b/, "method post bad");
|
||||
}
|
||||
{
|
||||
ok(contract::Foo::stest_prepost(4,0), "static method prepost");
|
||||
eval { contract::Foo::stest_prepost(-4,2) };
|
||||
like($@, qr/\bRuntimeError\b/, "static method pre bad");
|
||||
eval { contract::Foo::stest_prepost(4,-10) };
|
||||
like($@, qr/\bRuntimeError\b/, "static method post bad");
|
||||
}
|
||||
{
|
||||
my $b = contract::Bar->new();
|
||||
eval { $b->test_prepost(2,-4) };
|
||||
like($@, qr/\bRuntimeError\b/, "inherit pre bad");
|
||||
}
|
||||
{
|
||||
my $d = contract::D->new();
|
||||
eval { $d->foo(-1,1,1,1,1) };
|
||||
like($@, qr/\bRuntimeError\b/, "inherit pre D");
|
||||
eval { $d->foo(1,-1,1,1,1) };
|
||||
like($@, qr/\bRuntimeError\b/, "inherit pre D");
|
||||
eval { $d->foo(1,1,-1,1,1) };
|
||||
like($@, qr/\bRuntimeError\b/, "inherit pre D");
|
||||
eval { $d->foo(1,1,1,-1,1) };
|
||||
like($@, qr/\bRuntimeError\b/, "inherit pre D");
|
||||
eval { $d->foo(1,1,1,1,-1) };
|
||||
like($@, qr/\bRuntimeError\b/, "inherit pre D");
|
||||
|
||||
eval { $d->bar(-1,1,1,1,1) };
|
||||
like($@, qr/\bRuntimeError\b/, "inherit pre D");
|
||||
eval { $d->bar(1,-1,1,1,1) };
|
||||
like($@, qr/\bRuntimeError\b/, "inherit pre D");
|
||||
eval { $d->bar(1,1,-1,1,1) };
|
||||
like($@, qr/\bRuntimeError\b/, "inherit pre D");
|
||||
eval { $d->bar(1,1,1,-1,1) };
|
||||
like($@, qr/\bRuntimeError\b/, "inherit pre D");
|
||||
eval { $d->bar(1,1,1,1,-1) };
|
||||
like($@, qr/\bRuntimeError\b/, "inherit pre D");
|
||||
}
|
||||
|
||||
|
|
@ -1,161 +1,85 @@
|
|||
use default_args;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Test::More tests => 40;
|
||||
BEGIN { use_ok('default_args') }
|
||||
require_ok('default_args');
|
||||
|
||||
$true = 1;
|
||||
$false = 0;
|
||||
my $true = 1;
|
||||
my $false = '';
|
||||
|
||||
if (default_args::anonymous() != 7771) {
|
||||
die "anonymous (1) failed";
|
||||
}
|
||||
if (default_args::anonymous(1234) != 1234) {
|
||||
die "anonymous (2) failed";
|
||||
}
|
||||
is(default_args::anonymous(), 7771, "anonymous (1)");
|
||||
is(default_args::anonymous(1234), 1234, "anonymous (2)");
|
||||
|
||||
is(default_args::booltest(), $true, "booltest (1)");
|
||||
is(default_args::booltest($true), $true, "booltest (2)");
|
||||
is(default_args::booltest($false), $false, "booltest (3)");
|
||||
|
||||
if (default_args::booltest() != $true) {
|
||||
die "booltest (1) failed";
|
||||
}
|
||||
if (default_args::booltest($true) != $true) {
|
||||
die "booltest (2) failed";
|
||||
}
|
||||
if (default_args::booltest($false) != $false) {
|
||||
die "booltest (3) failed";
|
||||
}
|
||||
my $ec = new default_args::EnumClass();
|
||||
is($ec->blah(), $true, "EnumClass");
|
||||
|
||||
$ec = new default_args::EnumClass();
|
||||
if ($ec->blah() != $true) {
|
||||
die "EnumClass failed";
|
||||
}
|
||||
|
||||
if (default_args::casts1() != null) {
|
||||
die "casts1 failed";
|
||||
}
|
||||
|
||||
if (default_args::casts2() ne "Hello") {
|
||||
die "casts2 failed";
|
||||
}
|
||||
|
||||
if (default_args::casts1("Ciao") ne "Ciao") {
|
||||
die "casts1 not default failed";
|
||||
}
|
||||
|
||||
if (default_args::chartest1() ne 'x') {
|
||||
die "chartest1 failed";
|
||||
}
|
||||
|
||||
if (default_args::chartest2() != '\0') {
|
||||
die "chartest2 failed";
|
||||
}
|
||||
|
||||
if (default_args::chartest1('y') ne 'y') {
|
||||
die "chartest1 not default failed";
|
||||
}
|
||||
|
||||
if (default_args::chartest1('y') ne 'y') {
|
||||
die "chartest1 not default failed";
|
||||
}
|
||||
|
||||
if (default_args::reftest1() != 42) {
|
||||
die "reftest1 failed";
|
||||
}
|
||||
|
||||
if (default_args::reftest1(400) != 400) {
|
||||
die "reftest1 not default failed";
|
||||
}
|
||||
|
||||
if (default_args::reftest2() ne "hello") {
|
||||
die "reftest2 failed";
|
||||
}
|
||||
is(default_args::casts1(), undef, "casts1");
|
||||
is(default_args::casts2(), "Hello", "casts2");
|
||||
is(default_args::casts1("Ciao"), "Ciao", "casts1 not default");
|
||||
is(default_args::chartest1(), 'x', "chartest1");
|
||||
is(default_args::chartest2(), "\0", "chartest2");
|
||||
is(default_args::chartest1('y'), 'y', "chartest1 not default");
|
||||
is(default_args::reftest1(), 42, "reftest1");
|
||||
is(default_args::reftest1(400), 400, "reftest1 not default");
|
||||
is(default_args::reftest2(), "hello", "reftest2");
|
||||
|
||||
# rename
|
||||
$foo = new default_args::Foo();
|
||||
$foo->newname();
|
||||
$foo->newname(10);
|
||||
$foo->renamed3arg(10, 10.0);
|
||||
$foo->renamed2arg(10);
|
||||
$foo->renamed1arg();
|
||||
my $foo = new default_args::Foo();
|
||||
can_ok($foo, qw(newname renamed3arg renamed2arg renamed1arg));
|
||||
eval {
|
||||
$foo->newname();
|
||||
$foo->newname(10);
|
||||
$foo->renamed3arg(10, 10.0);
|
||||
$foo->renamed2arg(10);
|
||||
$foo->renamed1arg();
|
||||
};
|
||||
ok(not($@), '%rename handling');
|
||||
|
||||
# exception specifications
|
||||
eval { default_args::exceptionspec() };
|
||||
if (!$@) {
|
||||
die "exceptionspec 1 failed";
|
||||
}
|
||||
is($@, "ciao", "exceptionspec 1");
|
||||
eval { default_args::exceptionspec(-1) };
|
||||
if (!$@) {
|
||||
die "exceptionspec 2 failed";
|
||||
}
|
||||
is($@, "ciao", "exceptionspec 2");
|
||||
eval { default_args::exceptionspec(100) };
|
||||
if (!$@) {
|
||||
die "exceptionspec 3 failed";
|
||||
}
|
||||
is($@, '100', "exceptionspec 3");
|
||||
|
||||
$ex = new default_args::Except($false);
|
||||
eval { $ex.exspec() };
|
||||
if (!$@) {
|
||||
die "exspec 1 failed";
|
||||
}
|
||||
eval { $ex.exspec(-1) };
|
||||
if (!$@) {
|
||||
die "exspec 2 failed";
|
||||
}
|
||||
eval { $ex.exspec(100) };
|
||||
if (!$@) {
|
||||
die "exspec 3 failed";
|
||||
}
|
||||
eval { $ex = new default_args::Except($true) };
|
||||
if (!$@) {
|
||||
die "Except constructor 1 failed";
|
||||
}
|
||||
eval { $ex = new default_args::Except($true, -2) };
|
||||
if (!$@) {
|
||||
die "Except constructor 2 failed";
|
||||
}
|
||||
my $ex = new default_args::Except($false);
|
||||
|
||||
my $hit = 0;
|
||||
eval { $ex->exspec(); $hit = 1; };
|
||||
# a zero was thrown, an exception occured, but $@ is false
|
||||
is($hit, 0, "exspec 1");
|
||||
eval { $ex->exspec(-1) };
|
||||
is($@, "ciao", "exspec 2");
|
||||
eval { $ex->exspec(100) };
|
||||
is($@, 100, "exspec 3");
|
||||
eval { $ex = default_args::Except->new($true) };
|
||||
is($@, -1, "Except constructor 1");
|
||||
eval { $ex = default_args::Except->new($true, -2) };
|
||||
is($@, -2, "Except constructor 2");
|
||||
|
||||
#Default parameters in static class methods
|
||||
if (default_args::Statics::staticmethod() != 10+20+30) {
|
||||
die "staticmethod 1 failed";
|
||||
}
|
||||
if (default_args::Statics::staticmethod(100) != 100+20+30) {
|
||||
die "staticmethod 2 failed";
|
||||
}
|
||||
if (default_args::Statics::staticmethod(100,200,300) != 100+200+300) {
|
||||
die "staticmethod 3 failed";
|
||||
}
|
||||
is(default_args::Statics::staticmethod(), 60, "staticmethod 1");
|
||||
is(default_args::Statics::staticmethod(100), 150, "staticmethod 2");
|
||||
is(default_args::Statics::staticmethod(100,200,300), 600, "staticmethod 3");
|
||||
|
||||
$tricky = new default_args::Tricky();
|
||||
if ($tricky->privatedefault() != 200) {
|
||||
die "privatedefault failed";
|
||||
}
|
||||
if ($tricky->protectedint() != 2000) {
|
||||
die "protectedint failed";
|
||||
}
|
||||
if ($tricky->protecteddouble() != 987.654) {
|
||||
die "protecteddouble failed";
|
||||
}
|
||||
if ($tricky->functiondefault() != 500) {
|
||||
die "functiondefault failed";
|
||||
}
|
||||
if ($tricky->contrived() ne 'X') {
|
||||
die "contrived failed";
|
||||
}
|
||||
|
||||
if (default_args::constructorcall()->{val} != -1) {
|
||||
die "constructorcall test 1 failed";
|
||||
}
|
||||
|
||||
if (default_args::constructorcall(new default_args::Klass(2222))->{val} != 2222) {
|
||||
die "constructorcall test 2 failed";
|
||||
}
|
||||
|
||||
if (default_args::constructorcall(new default_args::Klass())->{val} != -1) {
|
||||
die "constructorcall test 3 failed";
|
||||
}
|
||||
my $tricky = new default_args::Tricky();
|
||||
is($tricky->privatedefault(), 200, "privatedefault");
|
||||
is($tricky->protectedint(), 2000, "protectedint");
|
||||
is($tricky->protecteddouble(), 987.654, "protecteddouble");
|
||||
is($tricky->functiondefault(), 500, "functiondefault");
|
||||
is($tricky->contrived(), 'X', "contrived");
|
||||
is(default_args::constructorcall()->{val}, -1, "constructorcall test 1");
|
||||
is(default_args::constructorcall(new default_args::Klass(2222))->{val},
|
||||
2222, "constructorcall test 2");
|
||||
is(default_args::constructorcall(new default_args::Klass())->{val},
|
||||
-1, "constructorcall test 3");
|
||||
|
||||
# const methods
|
||||
$cm = new default_args::ConstMethods();
|
||||
if ($cm->coo() != 20) {
|
||||
die "coo test 1 failed";
|
||||
}
|
||||
if ($cm->coo(1.0) != 20) {
|
||||
die "coo test 2 failed";
|
||||
}
|
||||
|
||||
my $cm = new default_args::ConstMethods();
|
||||
is($cm->coo(), 20, "coo test 1");
|
||||
is($cm->coo(1.0), 20, "coo test 2");
|
||||
|
|
|
|||
51
Examples/test-suite/perl5/default_constructor_runme.pl
Normal file
51
Examples/test-suite/perl5/default_constructor_runme.pl
Normal file
|
|
@ -0,0 +1,51 @@
|
|||
#!/usr/bin/perl
|
||||
use strict;
|
||||
use warnings;
|
||||
use Test::More tests => 20;
|
||||
BEGIN { use_ok('default_constructor') }
|
||||
require_ok('default_constructor');
|
||||
|
||||
isa_ok(eval { default_constructor::A->new() }, "default_constructor::A");
|
||||
isa_ok(eval { default_constructor::AA->new() }, "default_constructor::AA");
|
||||
is( eval { default_constructor::B->new() }, undef, "private default constructor");
|
||||
isa_ok(eval { default_constructor::B->new(0, 0) }, "default_constructor::B");
|
||||
is( eval { default_constructor::BB->new() }, undef, "inherited private default constructor");
|
||||
is( eval { default_constructor::C->new() }, undef, "protected default constructor");
|
||||
isa_ok(eval { default_constructor::CC->new() }, "default_constructor::CC");
|
||||
is( eval { default_constructor::D->new() }, undef, "private constructor");
|
||||
is( eval { default_constructor::DD->new() }, undef, "inherited private constructor");
|
||||
{ local $TODO = "default_constructor.i disagrees with our result";
|
||||
is( eval { default_constructor::AD->new() }, undef, "MI on A, D");
|
||||
}
|
||||
isa_ok(eval { default_constructor::E->new() }, "default_constructor::E");
|
||||
isa_ok(eval { default_constructor::EE->new() }, "default_constructor::EE");
|
||||
{ local $TODO = "default_constructor.i disagrees with our result";
|
||||
is( eval { default_constructor::EB->new() }, undef, "MI on E, B");
|
||||
}
|
||||
{ local $TODO = "destructor hiding seems off";
|
||||
my $hit = 0;
|
||||
eval {
|
||||
my $F = default_constructor::F->new();
|
||||
undef $F;
|
||||
$hit = 1;
|
||||
};
|
||||
ok(not($hit), "private destructor");
|
||||
$hit = 0;
|
||||
eval {
|
||||
my $G = default_constructor::G->new();
|
||||
undef $G;
|
||||
$hit = 1;
|
||||
};
|
||||
ok(not($hit), "protected destructor");
|
||||
$hit = 0;
|
||||
eval {
|
||||
my $G = default_constructor::GG->new();
|
||||
undef $G;
|
||||
$hit = 1;
|
||||
};
|
||||
ok(not($hit), "inherited protected destructor");
|
||||
}
|
||||
isa_ok(eval { default_constructor::HH->new(0, 0) }, "default_constructor::HH");
|
||||
is( eval { default_constructor::HH->new() }, undef, "templated protected constructor");
|
||||
|
||||
# TODO: sort out what needs to be tested from OSRSpatialReferenceShadow
|
||||
13
Examples/test-suite/perl5/dynamic_cast_runme.pl
Normal file
13
Examples/test-suite/perl5/dynamic_cast_runme.pl
Normal file
|
|
@ -0,0 +1,13 @@
|
|||
#!/usr/bin/perl
|
||||
use strict;
|
||||
use warnings;
|
||||
use Test::More tests => 3;
|
||||
BEGIN { use_ok('dynamic_cast') }
|
||||
require_ok('dynamic_cast');
|
||||
|
||||
my $f = dynamic_cast::Foo->new();
|
||||
my $b = dynamic_cast::Bar->new();
|
||||
my $x = $f->blah();
|
||||
my $y = $b->blah();
|
||||
my $a = dynamic_cast::do_test($y);
|
||||
is($a, "Bar::test");
|
||||
12
Examples/test-suite/perl5/enum_template_runme.pl
Executable file
12
Examples/test-suite/perl5/enum_template_runme.pl
Executable file
|
|
@ -0,0 +1,12 @@
|
|||
#!/usr/bin/perl
|
||||
use strict;
|
||||
use warnings;
|
||||
use Test::More tests => 4;
|
||||
BEGIN { use_ok('enum_template') }
|
||||
require_ok('enum_template');
|
||||
|
||||
# adapted from ../python/enum_template_runme.py
|
||||
|
||||
is(enum_template::MakeETest(), 1);
|
||||
|
||||
is(enum_template::TakeETest(0), undef);
|
||||
|
|
@ -1,20 +1,375 @@
|
|||
use enum_thorough;
|
||||
# an adaptation of ../java/enum_thorough_runme.java
|
||||
use strict;
|
||||
use warnings;
|
||||
use Test::More tests => 272;
|
||||
BEGIN { use_ok('enum_thorough') }
|
||||
require_ok('enum_thorough');
|
||||
|
||||
$enum_thorough::myColour;
|
||||
is($enum_thorough::ReallyAnInteger, 200, "Test Anon 1");
|
||||
|
||||
{
|
||||
my $red = $enum_thorough::red;
|
||||
is(enum_thorough::colourTest1($red), $red, "colourTest1");
|
||||
is(enum_thorough::colourTest2($red), $red, "colourTest2");
|
||||
is(enum_thorough::colourTest3($red), $red, "colourTest3");
|
||||
is(enum_thorough::colourTest4($red), $red, "colourTest4");
|
||||
isnt($enum_thorough::myColour, $red, "colour global get");
|
||||
$enum_thorough::myColour = $red;
|
||||
is($enum_thorough::myColour, $red, "colour global set");
|
||||
}
|
||||
{
|
||||
my $s = enum_thorough::SpeedClass->new();
|
||||
my $speed = $enum_thorough::SpeedClass::slow;
|
||||
ok(defined($speed), "SpeedClass.slow");
|
||||
is($s->speedTest1($speed), $speed, "speedTest 1");
|
||||
is($s->speedTest2($speed), $speed, "speedTest 2");
|
||||
is($s->speedTest3($speed), $speed, "speedTest 3");
|
||||
is($s->speedTest4($speed), $speed, "speedTest 4");
|
||||
is($s->speedTest5($speed), $speed, "speedTest 5");
|
||||
is($s->speedTest6($speed), $speed, "speedTest 6");
|
||||
is($s->speedTest7($speed), $speed, "speedTest 7");
|
||||
is($s->speedTest8($speed), $speed, "speedTest 8");
|
||||
is(enum_thorough::speedTest1($speed), $speed, "speedTest Global 1");
|
||||
is(enum_thorough::speedTest2($speed), $speed, "speedTest Global 2");
|
||||
is(enum_thorough::speedTest3($speed), $speed, "speedTest Global 3");
|
||||
is(enum_thorough::speedTest4($speed), $speed, "speedTest Global 4");
|
||||
is(enum_thorough::speedTest5($speed), $speed, "speedTest Global 5");
|
||||
}
|
||||
{
|
||||
my $s = enum_thorough::SpeedClass->new();
|
||||
my $slow = $enum_thorough::SpeedClass::slow;
|
||||
my $lightning = $enum_thorough::SpeedClass::lightning;
|
||||
is($s->{mySpeedtd1}, $slow, "mySpeedtd1 1");
|
||||
is($s->{mySpeedtd1}, 10, "mySpeedtd1 2");
|
||||
$s->{mySpeedtd1} = $lightning;
|
||||
is($s->{mySpeedtd1}, $lightning, "mySpeedtd1 3");
|
||||
is($s->{mySpeedtd1}, 31, "mySpeedtd1 4");
|
||||
}
|
||||
is(enum_thorough::namedanonTest1($enum_thorough::NamedAnon2),
|
||||
$enum_thorough::NamedAnon2, "namedanonTest1");
|
||||
{
|
||||
my $val = $enum_thorough::TwoNames2;
|
||||
is(enum_thorough::twonamesTest1($val), $val, "twonamesTest 1");
|
||||
is(enum_thorough::twonamesTest2($val), $val, "twonamesTest 2");
|
||||
is(enum_thorough::twonamesTest3($val), $val, "twonamesTest 3");
|
||||
}
|
||||
{ local $TODO = "shouldn't namespaces drop into a package?";
|
||||
my $val = $enum_thorough::AnonSpace::NamedAnonSpace2;
|
||||
ok(defined($val), "found enum value");
|
||||
SKIP: {
|
||||
skip "enum value not in expected package", 3 unless defined $val;
|
||||
is(enum_thorough::namedanonspaceTest1($val), $val, "namedanonspaceTest 1");
|
||||
is(enum_thorough::namedanonspaceTest2($val), $val, "namedanonspaceTest 2");
|
||||
is(enum_thorough::namedanonspaceTest3($val), $val, "namedanonspaceTest 3");
|
||||
}}
|
||||
{
|
||||
my $t = enum_thorough::TemplateClassInt->new();
|
||||
my $galileo = $enum_thorough::TemplateClassInt::galileo;
|
||||
is($t->scientistsTest1($galileo), $galileo, "scientistsTest 1");
|
||||
is($t->scientistsTest2($galileo), $galileo, "scientistsTest 2");
|
||||
is($t->scientistsTest3($galileo), $galileo, "scientistsTest 3");
|
||||
is($t->scientistsTest4($galileo), $galileo, "scientistsTest 4");
|
||||
is($t->scientistsTest5($galileo), $galileo, "scientistsTest 5");
|
||||
is($t->scientistsTest6($galileo), $galileo, "scientistsTest 6");
|
||||
is($t->scientistsTest7($galileo), $galileo, "scientistsTest 7");
|
||||
is($t->scientistsTest8($galileo), $galileo, "scientistsTest 8");
|
||||
is($t->scientistsTest9($galileo), $galileo, "scientistsTest 9");
|
||||
is($t->scientistsTestB($galileo), $galileo, "scientistsTest B");
|
||||
is($t->scientistsTestD($galileo), $galileo, "scientistsTest D");
|
||||
is($t->scientistsTestE($galileo), $galileo, "scientistsTest E");
|
||||
is($t->scientistsTestF($galileo), $galileo, "scientistsTest F");
|
||||
is($t->scientistsTestG($galileo), $galileo, "scientistsTest G");
|
||||
is($t->scientistsTestH($galileo), $galileo, "scientistsTest H");
|
||||
is($t->scientistsTestI($galileo), $galileo, "scientistsTest I");
|
||||
is($t->scientistsTestJ($galileo), $galileo, "scientistsTest J");
|
||||
|
||||
is(enum_thorough::scientistsTest1($galileo), $galileo, "scientistsTest Global 1");
|
||||
is(enum_thorough::scientistsTest2($galileo), $galileo, "scientistsTest Global 2");
|
||||
is(enum_thorough::scientistsTest3($galileo), $galileo, "scientistsTest Global 3");
|
||||
is(enum_thorough::scientistsTest4($galileo), $galileo, "scientistsTest Global 4");
|
||||
is(enum_thorough::scientistsTest5($galileo), $galileo, "scientistsTest Global 5");
|
||||
is(enum_thorough::scientistsTest6($galileo), $galileo, "scientistsTest Global 6");
|
||||
is(enum_thorough::scientistsTest7($galileo), $galileo, "scientistsTest Global 7");
|
||||
is(enum_thorough::scientistsTest8($galileo), $galileo, "scientistsTest Global 8");
|
||||
}
|
||||
{
|
||||
my $t = enum_thorough::TClassInt->new();
|
||||
my $bell = $enum_thorough::TClassInt::bell;
|
||||
my $galileo = $enum_thorough::TemplateClassInt::galileo;
|
||||
is($t->scientistsNameTest1($bell), $bell, "scientistsNameTest 1");
|
||||
is($t->scientistsNameTest2($bell), $bell, "scientistsNameTest 2");
|
||||
is($t->scientistsNameTest3($bell), $bell, "scientistsNameTest 3");
|
||||
is($t->scientistsNameTest4($bell), $bell, "scientistsNameTest 4");
|
||||
is($t->scientistsNameTest5($bell), $bell, "scientistsNameTest 5");
|
||||
is($t->scientistsNameTest6($bell), $bell, "scientistsNameTest 6");
|
||||
is($t->scientistsNameTest7($bell), $bell, "scientistsNameTest 7");
|
||||
is($t->scientistsNameTest8($bell), $bell, "scientistsNameTest 8");
|
||||
is($t->scientistsNameTest9($bell), $bell, "scientistsNameTest 9");
|
||||
is($t->scientistsNameTestB($bell), $bell, "scientistsNameTest B");
|
||||
is($t->scientistsNameTestD($bell), $bell, "scientistsNameTest D");
|
||||
is($t->scientistsNameTestE($bell), $bell, "scientistsNameTest E");
|
||||
is($t->scientistsNameTestF($bell), $bell, "scientistsNameTest F");
|
||||
is($t->scientistsNameTestG($bell), $bell, "scientistsNameTest G");
|
||||
is($t->scientistsNameTestH($bell), $bell, "scientistsNameTest H");
|
||||
is($t->scientistsNameTestI($bell), $bell, "scientistsNameTest I");
|
||||
|
||||
is($t->scientistsNameSpaceTest1($bell), $bell, "scientistsNameSpaceTest 1");
|
||||
is($t->scientistsNameSpaceTest2($bell), $bell, "scientistsNameSpaceTest 2");
|
||||
is($t->scientistsNameSpaceTest3($bell), $bell, "scientistsNameSpaceTest 3");
|
||||
is($t->scientistsNameSpaceTest4($bell), $bell, "scientistsNameSpaceTest 4");
|
||||
is($t->scientistsNameSpaceTest5($bell), $bell, "scientistsNameSpaceTest 5");
|
||||
is($t->scientistsNameSpaceTest6($bell), $bell, "scientistsNameSpaceTest 6");
|
||||
is($t->scientistsNameSpaceTest7($bell), $bell, "scientistsNameSpaceTest 7");
|
||||
|
||||
is($t->scientistsOtherTest1($galileo), $galileo, "scientistsOtherTest 1");
|
||||
is($t->scientistsOtherTest2($galileo), $galileo, "scientistsOtherTest 2");
|
||||
is($t->scientistsOtherTest3($galileo), $galileo, "scientistsOtherTest 3");
|
||||
is($t->scientistsOtherTest4($galileo), $galileo, "scientistsOtherTest 4");
|
||||
is($t->scientistsOtherTest5($galileo), $galileo, "scientistsOtherTest 5");
|
||||
is($t->scientistsOtherTest6($galileo), $galileo, "scientistsOtherTest 6");
|
||||
is($t->scientistsOtherTest7($galileo), $galileo, "scientistsOtherTest 7");
|
||||
|
||||
is(enum_thorough::scientistsNameTest1($bell), $bell, "scientistsNameTest Global 1");
|
||||
is(enum_thorough::scientistsNameTest2($bell), $bell, "scientistsNameTest Global 2");
|
||||
is(enum_thorough::scientistsNameTest3($bell), $bell, "scientistsNameTest Global 3");
|
||||
is(enum_thorough::scientistsNameTest4($bell), $bell, "scientistsNameTest Global 4");
|
||||
is(enum_thorough::scientistsNameTest5($bell), $bell, "scientistsNameTest Global 5");
|
||||
is(enum_thorough::scientistsNameTest6($bell), $bell, "scientistsNameTest Global 6");
|
||||
is(enum_thorough::scientistsNameTest7($bell), $bell, "scientistsNameTest Global 7");
|
||||
|
||||
is(enum_thorough::scientistsNameSpaceTest1($bell), $bell, "scientistsNameSpaceTest Global 1");
|
||||
is(enum_thorough::scientistsNameSpaceTest2($bell), $bell, "scientistsNameSpaceTest Global 2");
|
||||
is(enum_thorough::scientistsNameSpaceTest3($bell), $bell, "scientistsNameSpaceTest Global 3");
|
||||
is(enum_thorough::scientistsNameSpaceTest4($bell), $bell, "scientistsNameSpaceTest Global 4");
|
||||
is(enum_thorough::scientistsNameSpaceTest5($bell), $bell, "scientistsNameSpaceTest Global 5");
|
||||
is(enum_thorough::scientistsNameSpaceTest6($bell), $bell, "scientistsNameSpaceTest Global 6");
|
||||
is(enum_thorough::scientistsNameSpaceTest7($bell), $bell, "scientistsNameSpaceTest Global 7");
|
||||
|
||||
is(enum_thorough::scientistsNameSpaceTest8($bell), $bell, "scientistsNameSpaceTest Global 8");
|
||||
is(enum_thorough::scientistsNameSpaceTest9($bell), $bell, "scientistsNameSpaceTest Global 9");
|
||||
is(enum_thorough::scientistsNameSpaceTestA($bell), $bell, "scientistsNameSpaceTest Global A");
|
||||
is(enum_thorough::scientistsNameSpaceTestB($bell), $bell, "scientistsNameSpaceTest Global B");
|
||||
is(enum_thorough::scientistsNameSpaceTestC($bell), $bell, "scientistsNameSpaceTest Global C");
|
||||
is(enum_thorough::scientistsNameSpaceTestD($bell), $bell, "scientistsNameSpaceTest Global D");
|
||||
is(enum_thorough::scientistsNameSpaceTestE($bell), $bell, "scientistsNameSpaceTest Global E");
|
||||
|
||||
is(enum_thorough::scientistsNameSpaceTestF($bell), $bell, "scientistsNameSpaceTest Global F");
|
||||
is(enum_thorough::scientistsNameSpaceTestG($bell), $bell, "scientistsNameSpaceTest Global G");
|
||||
is(enum_thorough::scientistsNameSpaceTestH($bell), $bell, "scientistsNameSpaceTest Global H");
|
||||
is(enum_thorough::scientistsNameSpaceTestI($bell), $bell, "scientistsNameSpaceTest Global I");
|
||||
is(enum_thorough::scientistsNameSpaceTestJ($bell), $bell, "scientistsNameSpaceTest Global J");
|
||||
is(enum_thorough::scientistsNameSpaceTestK($bell), $bell, "scientistsNameSpaceTest Global K");
|
||||
is(enum_thorough::scientistsNameSpaceTestL($bell), $bell, "scientistsNameSpaceTest Global L");
|
||||
}
|
||||
{
|
||||
my $val = $enum_thorough::argh;
|
||||
is(enum_thorough::renameTest1($val), $val, "renameTest Global 1");
|
||||
is(enum_thorough::renameTest2($val), $val, "renameTest Global 2");
|
||||
}
|
||||
{
|
||||
my $n = enum_thorough::NewNameStruct->new();
|
||||
is($n->renameTest1($enum_thorough::NewNameStruct::bang), $enum_thorough::NewNameStruct::bang, "renameTest 1");
|
||||
is($n->renameTest2($enum_thorough::NewNameStruct::bang), $enum_thorough::NewNameStruct::bang, "renameTest 2");
|
||||
is($n->renameTest3($enum_thorough::NewNameStruct::simple1), $enum_thorough::NewNameStruct::simple1, "renameTest 3");
|
||||
is($n->renameTest4($enum_thorough::NewNameStruct::doublename1), $enum_thorough::NewNameStruct::doublename1, "renameTest 4");
|
||||
is($n->renameTest5($enum_thorough::NewNameStruct::doublename1), $enum_thorough::NewNameStruct::doublename1, "renameTest 5");
|
||||
is($n->renameTest6($enum_thorough::NewNameStruct::singlename1), $enum_thorough::NewNameStruct::singlename1, "renameTest 6");
|
||||
}
|
||||
{
|
||||
is(enum_thorough::renameTest3($enum_thorough::NewNameStruct::bang), $enum_thorough::NewNameStruct::bang, "renameTest Global 3");
|
||||
is(enum_thorough::renameTest4($enum_thorough::NewNameStruct::simple1), $enum_thorough::NewNameStruct::simple1, "renameTest Global 4");
|
||||
is(enum_thorough::renameTest5($enum_thorough::NewNameStruct::doublename1), $enum_thorough::NewNameStruct::doublename1, "renameTest Global 5");
|
||||
is(enum_thorough::renameTest6($enum_thorough::NewNameStruct::doublename1), $enum_thorough::NewNameStruct::doublename1, "renameTest Global 6");
|
||||
is(enum_thorough::renameTest7($enum_thorough::NewNameStruct::singlename1), $enum_thorough::NewNameStruct::singlename1, "renameTest Global 7");
|
||||
}
|
||||
{
|
||||
my $t = enum_thorough::TreesClass->new();
|
||||
my $pine = $enum_thorough::TreesClass::pine;
|
||||
is($t->treesTest1($pine), $pine, "treesTest 1");
|
||||
is($t->treesTest2($pine), $pine, "treesTest 2");
|
||||
is($t->treesTest3($pine), $pine, "treesTest 3");
|
||||
is($t->treesTest4($pine), $pine, "treesTest 4");
|
||||
is($t->treesTest5($pine), $pine, "treesTest 5");
|
||||
is($t->treesTest6($pine), $pine, "treesTest 6");
|
||||
is($t->treesTest7($pine), $pine, "treesTest 7");
|
||||
is($t->treesTest8($pine), $pine, "treesTest 8");
|
||||
is($t->treesTest9($pine), $pine, "treesTest 9");
|
||||
is($t->treesTestA($pine), $pine, "treesTest A");
|
||||
is($t->treesTestB($pine), $pine, "treesTest B");
|
||||
is($t->treesTestC($pine), $pine, "treesTest C");
|
||||
is($t->treesTestD($pine), $pine, "treesTest D");
|
||||
is($t->treesTestE($pine), $pine, "treesTest E");
|
||||
is($t->treesTestF($pine), $pine, "treesTest F");
|
||||
is($t->treesTestG($pine), $pine, "treesTest G");
|
||||
is($t->treesTestH($pine), $pine, "treesTest H");
|
||||
is($t->treesTestI($pine), $pine, "treesTest I");
|
||||
is($t->treesTestJ($pine), $pine, "treesTest J");
|
||||
is($t->treesTestK($pine), $pine, "treesTest K");
|
||||
is($t->treesTestL($pine), $pine, "treesTest L");
|
||||
is($t->treesTestM($pine), $pine, "treesTest M");
|
||||
is($t->treesTestN($pine), $pine, "treesTest N");
|
||||
is($t->treesTestO($pine), $pine, "treesTest O");
|
||||
|
||||
is(enum_thorough::treesTest1($pine), $pine, "treesTest Global 1");
|
||||
is(enum_thorough::treesTest2($pine), $pine, "treesTest Global 2");
|
||||
is(enum_thorough::treesTest3($pine), $pine, "treesTest Global 3");
|
||||
is(enum_thorough::treesTest4($pine), $pine, "treesTest Global 4");
|
||||
is(enum_thorough::treesTest5($pine), $pine, "treesTest Global 5");
|
||||
is(enum_thorough::treesTest6($pine), $pine, "treesTest Global 6");
|
||||
is(enum_thorough::treesTest7($pine), $pine, "treesTest Global 7");
|
||||
is(enum_thorough::treesTest8($pine), $pine, "treesTest Global 8");
|
||||
is(enum_thorough::treesTest9($pine), $pine, "treesTest Global 9");
|
||||
is(enum_thorough::treesTestA($pine), $pine, "treesTest Global A");
|
||||
is(enum_thorough::treesTestB($pine), $pine, "treesTest Global B");
|
||||
is(enum_thorough::treesTestC($pine), $pine, "treesTest Global C");
|
||||
is(enum_thorough::treesTestD($pine), $pine, "treesTest Global D");
|
||||
is(enum_thorough::treesTestE($pine), $pine, "treesTest Global E");
|
||||
is(enum_thorough::treesTestF($pine), $pine, "treesTest Global F");
|
||||
is(enum_thorough::treesTestG($pine), $pine, "treesTest Global G");
|
||||
is(enum_thorough::treesTestH($pine), $pine, "treesTest Global H");
|
||||
is(enum_thorough::treesTestI($pine), $pine, "treesTest Global I");
|
||||
is(enum_thorough::treesTestJ($pine), $pine, "treesTest Global J");
|
||||
is(enum_thorough::treesTestK($pine), $pine, "treesTest Global K");
|
||||
is(enum_thorough::treesTestL($pine), $pine, "treesTest Global L");
|
||||
is(enum_thorough::treesTestM($pine), $pine, "treesTest Global M");
|
||||
is(enum_thorough::treesTestO($pine), $pine, "treesTest Global O");
|
||||
is(enum_thorough::treesTestP($pine), $pine, "treesTest Global P");
|
||||
is(enum_thorough::treesTestQ($pine), $pine, "treesTest Global Q");
|
||||
is(enum_thorough::treesTestR($pine), $pine, "treesTest Global R");
|
||||
}
|
||||
{
|
||||
my $h = enum_thorough::HairStruct->new();
|
||||
my $ginger = $enum_thorough::HairStruct::ginger;
|
||||
|
||||
is($h->hairTest1($ginger), $ginger, "hairTest 1");
|
||||
is($h->hairTest2($ginger), $ginger, "hairTest 2");
|
||||
is($h->hairTest3($ginger), $ginger, "hairTest 3");
|
||||
is($h->hairTest4($ginger), $ginger, "hairTest 4");
|
||||
is($h->hairTest5($ginger), $ginger, "hairTest 5");
|
||||
is($h->hairTest6($ginger), $ginger, "hairTest 6");
|
||||
is($h->hairTest7($ginger), $ginger, "hairTest 7");
|
||||
is($h->hairTest8($ginger), $ginger, "hairTest 8");
|
||||
is($h->hairTest9($ginger), $ginger, "hairTest 9");
|
||||
is($h->hairTestA($ginger), $ginger, "hairTest A");
|
||||
is($h->hairTestB($ginger), $ginger, "hairTest B");
|
||||
|
||||
my $red = $enum_thorough::red;
|
||||
is($h->colourTest1($red), $red, "colourTest HairStruct 1");
|
||||
is($h->colourTest2($red), $red, "colourTest HairStruct 2");
|
||||
is($h->namedanonTest1($enum_thorough::NamedAnon2), $enum_thorough::NamedAnon2, "namedanonTest HairStruct 1");
|
||||
{ local $TODO = "shouldn't namespaces drop into a package?";
|
||||
ok(defined($enum_thorough::AnonSpace::NamedAnonSpace2), "found enum value");
|
||||
SKIP: {
|
||||
skip "enum value not in expected package", 1 unless defined $enum_thorough::AnonSpace::NamedAnonSpace2;
|
||||
is($h->namedanonspaceTest1($enum_thorough::AnonSpace::NamedAnonSpace2), $enum_thorough::AnonSpace::NamedAnonSpace2, "namedanonspaceTest HairStruct 1");
|
||||
}}
|
||||
|
||||
|
||||
my $fir = $enum_thorough::TreesClass::fir;
|
||||
is($h->treesGlobalTest1($fir), $fir, "treesGlobalTest1 HairStruct 1");
|
||||
is($h->treesGlobalTest2($fir), $fir, "treesGlobalTest1 HairStruct 2");
|
||||
is($h->treesGlobalTest3($fir), $fir, "treesGlobalTest1 HairStruct 3");
|
||||
is($h->treesGlobalTest4($fir), $fir, "treesGlobalTest1 HairStruct 4");
|
||||
}
|
||||
{
|
||||
my $blonde = $enum_thorough::HairStruct::blonde;
|
||||
is(enum_thorough::hairTest1($blonde), $blonde, "hairTest Global 1");
|
||||
is(enum_thorough::hairTest2($blonde), $blonde, "hairTest Global 2");
|
||||
is(enum_thorough::hairTest3($blonde), $blonde, "hairTest Global 3");
|
||||
is(enum_thorough::hairTest4($blonde), $blonde, "hairTest Global 4");
|
||||
is(enum_thorough::hairTest5($blonde), $blonde, "hairTest Global 5");
|
||||
is(enum_thorough::hairTest6($blonde), $blonde, "hairTest Global 6");
|
||||
is(enum_thorough::hairTest7($blonde), $blonde, "hairTest Global 7");
|
||||
is(enum_thorough::hairTest8($blonde), $blonde, "hairTest Global 8");
|
||||
is(enum_thorough::hairTest9($blonde), $blonde, "hairTest Global 9");
|
||||
is(enum_thorough::hairTestA($blonde), $blonde, "hairTest Global A");
|
||||
is(enum_thorough::hairTestB($blonde), $blonde, "hairTest Global B");
|
||||
is(enum_thorough::hairTestC($blonde), $blonde, "hairTest Global C");
|
||||
|
||||
is(enum_thorough::hairTestA1($blonde), $blonde, "hairTest Global A1");
|
||||
is(enum_thorough::hairTestA2($blonde), $blonde, "hairTest Global A2");
|
||||
is(enum_thorough::hairTestA3($blonde), $blonde, "hairTest Global A3");
|
||||
is(enum_thorough::hairTestA4($blonde), $blonde, "hairTest Global A4");
|
||||
is(enum_thorough::hairTestA5($blonde), $blonde, "hairTest Global A5");
|
||||
is(enum_thorough::hairTestA6($blonde), $blonde, "hairTest Global A6");
|
||||
is(enum_thorough::hairTestA7($blonde), $blonde, "hairTest Global A7");
|
||||
is(enum_thorough::hairTestA8($blonde), $blonde, "hairTest Global A8");
|
||||
is(enum_thorough::hairTestA9($blonde), $blonde, "hairTest Global A9");
|
||||
is(enum_thorough::hairTestAA($blonde), $blonde, "hairTest Global AA");
|
||||
is(enum_thorough::hairTestAB($blonde), $blonde, "hairTest Global AB");
|
||||
is(enum_thorough::hairTestAC($blonde), $blonde, "hairTest Global AC");
|
||||
|
||||
is(enum_thorough::hairTestB1($blonde), $blonde, "hairTest Global B1");
|
||||
is(enum_thorough::hairTestB2($blonde), $blonde, "hairTest Global B2");
|
||||
is(enum_thorough::hairTestB3($blonde), $blonde, "hairTest Global B3");
|
||||
is(enum_thorough::hairTestB4($blonde), $blonde, "hairTest Global B4");
|
||||
is(enum_thorough::hairTestB5($blonde), $blonde, "hairTest Global B5");
|
||||
is(enum_thorough::hairTestB6($blonde), $blonde, "hairTest Global B6");
|
||||
is(enum_thorough::hairTestB7($blonde), $blonde, "hairTest Global B7");
|
||||
is(enum_thorough::hairTestB8($blonde), $blonde, "hairTest Global B8");
|
||||
is(enum_thorough::hairTestB9($blonde), $blonde, "hairTest Global B9");
|
||||
is(enum_thorough::hairTestBA($blonde), $blonde, "hairTest Global BA");
|
||||
is(enum_thorough::hairTestBB($blonde), $blonde, "hairTest Global BB");
|
||||
is(enum_thorough::hairTestBC($blonde), $blonde, "hairTest Global BC");
|
||||
|
||||
is(enum_thorough::hairTestC1($blonde), $blonde, "hairTest Global C1");
|
||||
is(enum_thorough::hairTestC2($blonde), $blonde, "hairTest Global C2");
|
||||
is(enum_thorough::hairTestC3($blonde), $blonde, "hairTest Global C3");
|
||||
is(enum_thorough::hairTestC4($blonde), $blonde, "hairTest Global C4");
|
||||
is(enum_thorough::hairTestC5($blonde), $blonde, "hairTest Global C5");
|
||||
is(enum_thorough::hairTestC6($blonde), $blonde, "hairTest Global C6");
|
||||
is(enum_thorough::hairTestC7($blonde), $blonde, "hairTest Global C7");
|
||||
is(enum_thorough::hairTestC8($blonde), $blonde, "hairTest Global C8");
|
||||
is(enum_thorough::hairTestC9($blonde), $blonde, "hairTest Global C9");
|
||||
is(enum_thorough::hairTestCA($blonde), $blonde, "hairTest Global CA");
|
||||
is(enum_thorough::hairTestCB($blonde), $blonde, "hairTest Global CB");
|
||||
is(enum_thorough::hairTestCC($blonde), $blonde, "hairTest Global CC");
|
||||
}
|
||||
{
|
||||
my $f = enum_thorough::FirStruct->new();
|
||||
my $blonde = $enum_thorough::HairStruct::blonde;
|
||||
|
||||
is($f->hairTestFir1($blonde), $blonde, "hairTestFir 1");
|
||||
is($f->hairTestFir2($blonde), $blonde, "hairTestFir 2");
|
||||
is($f->hairTestFir3($blonde), $blonde, "hairTestFir 3");
|
||||
is($f->hairTestFir4($blonde), $blonde, "hairTestFir 4");
|
||||
is($f->hairTestFir5($blonde), $blonde, "hairTestFir 5");
|
||||
is($f->hairTestFir6($blonde), $blonde, "hairTestFir 6");
|
||||
is($f->hairTestFir7($blonde), $blonde, "hairTestFir 7");
|
||||
is($f->hairTestFir8($blonde), $blonde, "hairTestFir 8");
|
||||
is($f->hairTestFir9($blonde), $blonde, "hairTestFir 9");
|
||||
is($f->hairTestFirA($blonde), $blonde, "hairTestFir A");
|
||||
}
|
||||
{
|
||||
$enum_thorough::GlobalInstance = $enum_thorough::globalinstance2;
|
||||
is($enum_thorough::GlobalInstance, $enum_thorough::globalinstance2, "GlobalInstance 1");
|
||||
|
||||
my $i = enum_thorough::Instances->new();
|
||||
$i->{MemberInstance} = $enum_thorough::Instances::memberinstance3;
|
||||
is($i->{MemberInstance}, $enum_thorough::Instances::memberinstance3, "MemberInstance 1");
|
||||
}
|
||||
{
|
||||
is(enum_thorough::repeatTest($enum_thorough::one), 1, "repeatTest 1");
|
||||
is(enum_thorough::repeatTest($enum_thorough::initial), 1, "repeatTest 2");
|
||||
is(enum_thorough::repeatTest($enum_thorough::two), 2, "repeatTest 3");
|
||||
is(enum_thorough::repeatTest($enum_thorough::three), 3, "repeatTest 4");
|
||||
{ local $TODO = "overzealous keyword guarding";
|
||||
ok(defined($enum_thorough::last), "found enum value");
|
||||
SKIP: {
|
||||
skip "enum value not in expected package", 1 unless defined $enum_thorough::last;
|
||||
is(enum_thorough::repeatTest($enum_thorough::last), 3, "repeatTest 5");
|
||||
}}
|
||||
is(enum_thorough::repeatTest($enum_thorough::end), 3, "repeatTest 6");
|
||||
}
|
||||
|
||||
# these were the preexisting Perl testcases before the port.
|
||||
|
||||
# Just test an in and out typemap for enum SWIGTYPE and const enum SWIGTYPE & typemaps
|
||||
if (enum_thorough::speedTest4($enum_thorough::SpeedClass::slow) != $enum_thorough::SpeedClass::slow) {
|
||||
die "speedTest Global 4 failed";
|
||||
}
|
||||
if (enum_thorough::speedTest5($enum_thorough::SpeedClass::slow) != $enum_thorough::SpeedClass::slow) {
|
||||
die "speedTest Global 5 failed";
|
||||
}
|
||||
|
||||
|
||||
if (enum_thorough::speedTest4($enum_thorough::SpeedClass::fast) != $enum_thorough::SpeedClass::fast) {
|
||||
die "speedTest Global 4 failed";
|
||||
}
|
||||
if (enum_thorough::speedTest5($enum_thorough::SpeedClass::fast) != $enum_thorough::SpeedClass::fast) {
|
||||
die "speedTest Global 5 failed";
|
||||
}
|
||||
is(enum_thorough::speedTest4($enum_thorough::SpeedClass::slow),
|
||||
$enum_thorough::SpeedClass::slow, "speedTest Global 4");
|
||||
is(enum_thorough::speedTest5($enum_thorough::SpeedClass::slow),
|
||||
$enum_thorough::SpeedClass::slow, "speedTest Global 5 failed");
|
||||
is(enum_thorough::speedTest4($enum_thorough::SpeedClass::fast),
|
||||
$enum_thorough::SpeedClass::fast, "speedTest Global 4 failed");
|
||||
is(enum_thorough::speedTest5($enum_thorough::SpeedClass::fast),
|
||||
$enum_thorough::SpeedClass::fast, "speedTest Global 5 failed");
|
||||
|
|
|
|||
25
Examples/test-suite/perl5/exception_order_runme.pl
Normal file
25
Examples/test-suite/perl5/exception_order_runme.pl
Normal file
|
|
@ -0,0 +1,25 @@
|
|||
#!/usr/bin/perl
|
||||
use strict;
|
||||
use warnings;
|
||||
use Test::More tests => 7;
|
||||
BEGIN { use_ok('exception_order') }
|
||||
require_ok('exception_order');
|
||||
|
||||
# adapted from ../python/exception_order_runme.py
|
||||
|
||||
my $a = exception_order::A->new();
|
||||
|
||||
eval { $a->foo() };
|
||||
isa_ok($@, "exception_order::E1");
|
||||
|
||||
eval { $a->bar() };
|
||||
isa_ok($@, "exception_order::E2");
|
||||
|
||||
eval { $a->foobar() };
|
||||
like($@, qr/\bpostcatch unknown\b/);
|
||||
|
||||
eval { $a->barfoo(1) };
|
||||
isa_ok($@, "exception_order::E1");
|
||||
|
||||
eval { $a->barfoo(2) };
|
||||
isa_ok($@, "exception_order::E2");
|
||||
|
|
@ -1,6 +1,11 @@
|
|||
use global_vars;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Test::More tests => 4;
|
||||
BEGIN { use_ok('global_vars') }
|
||||
require_ok('global_vars');
|
||||
|
||||
|
||||
$an = new global_vars::A();
|
||||
my $an = new global_vars::A();
|
||||
isa_ok($an, 'global_vars::A');
|
||||
$global_vars::ap = $an;
|
||||
is($global_vars::ap, $an, "global var assignment");
|
||||
|
||||
|
|
|
|||
17
Examples/test-suite/perl5/grouping_runme.pl
Executable file
17
Examples/test-suite/perl5/grouping_runme.pl
Executable file
|
|
@ -0,0 +1,17 @@
|
|||
#!/usr/bin/perl
|
||||
use strict;
|
||||
use warnings;
|
||||
use Test::More tests => 6;
|
||||
BEGIN { use_ok('grouping') }
|
||||
require_ok('grouping');
|
||||
|
||||
# adapted from ../python/grouping_runme.py
|
||||
|
||||
is(grouping::test1(42), 42);
|
||||
|
||||
isnt(eval { grouping::test2(42) }, undef);
|
||||
|
||||
is(grouping::do_unary(37, $grouping::NEGATE), -37);
|
||||
|
||||
$grouping::test3 = 42;
|
||||
is($grouping::test3, 42);
|
||||
33
Examples/test-suite/perl5/ignore_parameter_runme.pl
Executable file
33
Examples/test-suite/perl5/ignore_parameter_runme.pl
Executable file
|
|
@ -0,0 +1,33 @@
|
|||
#!/usr/bin/perl
|
||||
use strict;
|
||||
use warnings;
|
||||
use Test::More tests => 14;
|
||||
BEGIN { use_ok('ignore_parameter') }
|
||||
require_ok('ignore_parameter');
|
||||
|
||||
# adapted from ../java/ignore_parameter_runme.java
|
||||
|
||||
# Runtime test checking the %typemap(ignore) macro
|
||||
|
||||
# Compilation will ensure the number of arguments and type are correct.
|
||||
# Then check the return value is the same as the value given to the ignored parameter.
|
||||
is(ignore_parameter::jaguar(200, 0.0), "hello", "jaguar()");
|
||||
is(ignore_parameter::lotus("fast", 0.0), 101, "lotus()");
|
||||
is(ignore_parameter::tvr("fast", 200), 8.8, "tvr()");
|
||||
is(ignore_parameter::ferrari(), 101, "ferrari()");
|
||||
|
||||
my $sc = new ignore_parameter::SportsCars();
|
||||
is($sc->daimler(200, 0.0), "hello", "daimler()");
|
||||
is($sc->astonmartin("fast", 0.0), 101, "astonmartin()");
|
||||
is($sc->bugatti("fast", 200), 8.8, "bugatti()");
|
||||
is($sc->lamborghini(), 101, "lamborghini()");
|
||||
|
||||
# Check constructors are also generated correctly
|
||||
my $mc = eval { new ignore_parameter::MiniCooper(200, 0.0) };
|
||||
isa_ok($mc, 'ignore_parameter::MiniCooper');
|
||||
my $mm = eval { new ignore_parameter::MorrisMinor("slow", 0.0) };
|
||||
isa_ok($mm, 'ignore_parameter::MorrisMinor');
|
||||
my $fa = eval { new ignore_parameter::FordAnglia("slow", 200) };
|
||||
isa_ok($fa, 'ignore_parameter::FordAnglia');
|
||||
my $aa = eval { new ignore_parameter::AustinAllegro() };
|
||||
isa_ok($aa, 'ignore_parameter::AustinAllegro');
|
||||
|
|
@ -1,7 +1,13 @@
|
|||
use import_nomodule;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Test::More tests => 4;
|
||||
BEGIN { use_ok('import_nomodule') }
|
||||
require_ok('import_nomodule');
|
||||
|
||||
$f = import_nomodule::create_Foo();
|
||||
my $f = import_nomodule::create_Foo();
|
||||
import_nomodule::test1($f,42);
|
||||
ok(1, "basecase");
|
||||
|
||||
$b = new import_nomodule::Bar();
|
||||
my $b = new import_nomodule::Bar();
|
||||
import_nomodule::test1($b,37);
|
||||
ok(1, "testcase");
|
||||
|
|
|
|||
12
Examples/test-suite/perl5/inctest_runme.pl
Normal file
12
Examples/test-suite/perl5/inctest_runme.pl
Normal file
|
|
@ -0,0 +1,12 @@
|
|||
#!/usr/bin/perl
|
||||
use strict;
|
||||
use warnings;
|
||||
use Test::More tests => 3;
|
||||
BEGIN { use_ok('inctest') }
|
||||
require_ok('inctest');
|
||||
|
||||
my $things = inctest::MY_THINGS->new();
|
||||
my $i = 0;
|
||||
$things->{IntegerMember} = $i;
|
||||
my $d = $things->{DoubleMember};
|
||||
ok(1);
|
||||
20
Examples/test-suite/perl5/inherit_missing_runme.pl
Executable file
20
Examples/test-suite/perl5/inherit_missing_runme.pl
Executable file
|
|
@ -0,0 +1,20 @@
|
|||
#!/usr/bin/perl
|
||||
use strict;
|
||||
use warnings;
|
||||
use Test::More tests => 5;
|
||||
BEGIN { use_ok('inherit_missing') }
|
||||
require_ok('inherit_missing');
|
||||
|
||||
# adapted from ../python/inherit_missing_runme.py
|
||||
|
||||
my $a = inherit_missing::new_Foo();
|
||||
my $b = inherit_missing::Bar->new();
|
||||
my $c = inherit_missing::Spam->new();
|
||||
|
||||
is(inherit_missing::do_blah($a), "Foo::blah");
|
||||
|
||||
is(inherit_missing::do_blah($b), "Bar::blah");
|
||||
|
||||
is(inherit_missing::do_blah($c), "Spam::blah");
|
||||
|
||||
inherit_missing::delete_Foo($a);
|
||||
|
|
@ -1,9 +1,9 @@
|
|||
use inherit;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Test::More tests => 3;
|
||||
BEGIN { use_ok('inherit') }
|
||||
require_ok('inherit');
|
||||
|
||||
$der = new inherit::CDerived();
|
||||
$str = $der->Foo();
|
||||
|
||||
if ($str ne "CBase::Foo") {
|
||||
die "test failed";
|
||||
}
|
||||
my $der = new inherit::CDerived();
|
||||
is($der->Foo(), "CBase::Foo", "inherit test");
|
||||
|
||||
|
|
|
|||
72
Examples/test-suite/perl5/li_carrays_runme.pl
Normal file
72
Examples/test-suite/perl5/li_carrays_runme.pl
Normal file
|
|
@ -0,0 +1,72 @@
|
|||
#!/usr/bin/perl
|
||||
use strict;
|
||||
use warnings;
|
||||
use Test::More tests => 38;
|
||||
BEGIN { use_ok('li_carrays') }
|
||||
require_ok('li_carrays');
|
||||
|
||||
# array_class
|
||||
{
|
||||
my $length = 5;
|
||||
my $xyArray = new li_carrays::XYArray($length);
|
||||
for (my $i=0; $i<$length; $i++) {
|
||||
my $xy = $xyArray->getitem($i);
|
||||
$xy->{x} = $i*10;
|
||||
$xy->{y} = $i*100;
|
||||
$xyArray->setitem($i, $xy);
|
||||
}
|
||||
for (my $i=0; $i<$length; $i++) {
|
||||
is($xyArray->getitem($i)->{x}, $i*10);
|
||||
is($xyArray->getitem($i)->{y}, $i*100);
|
||||
}
|
||||
}
|
||||
|
||||
{
|
||||
# global array variable
|
||||
my $length = 5;
|
||||
my $xyArrayPointer = $li_carrays::globalXYArray;
|
||||
my $xyArray = li_carrays::XYArray::frompointer($xyArrayPointer);
|
||||
for (my $i=0; $i<$length; $i++) {
|
||||
my $xy = $xyArray->getitem($i);
|
||||
$xy->{x} = $i*10;
|
||||
$xy->{y} = $i*100;
|
||||
$xyArray->setitem($i, $xy);
|
||||
}
|
||||
for (my $i=0; $i<$length; $i++) {
|
||||
is($xyArray->getitem($i)->{x}, $i*10);
|
||||
is($xyArray->getitem($i)->{y}, $i*100);
|
||||
}
|
||||
}
|
||||
|
||||
# array_functions
|
||||
{
|
||||
my $length = 5;
|
||||
my $abArray = li_carrays::new_ABArray($length);
|
||||
for (my $i=0; $i<$length; $i++) {
|
||||
my $ab = li_carrays::ABArray_getitem($abArray, $i);
|
||||
$ab->{a} = $i*10;
|
||||
$ab->{b} = $i*100;
|
||||
li_carrays::ABArray_setitem($abArray, $i, $ab);
|
||||
}
|
||||
for (my $i=0; $i<$length; $i++) {
|
||||
is(li_carrays::ABArray_getitem($abArray, $i)->{a}, $i*10);
|
||||
is(li_carrays::ABArray_getitem($abArray, $i)->{b}, $i*100);
|
||||
}
|
||||
li_carrays::delete_ABArray($abArray);
|
||||
}
|
||||
|
||||
{
|
||||
# global array variable
|
||||
my $length = 3;
|
||||
my $abArray = $li_carrays::globalABArray;
|
||||
for (my $i=0; $i<$length; $i++) {
|
||||
my $ab = li_carrays::ABArray_getitem($abArray, $i);
|
||||
$ab->{a} = $i*10;
|
||||
$ab->{b} = $i*100;
|
||||
li_carrays::ABArray_setitem($abArray, $i, $ab);
|
||||
}
|
||||
for (my $i=0; $i<$length; $i++) {
|
||||
is(li_carrays::ABArray_getitem($abArray, $i)->{a}, $i*10);
|
||||
is(li_carrays::ABArray_getitem($abArray, $i)->{b}, $i*100);
|
||||
}
|
||||
}
|
||||
|
|
@ -1,11 +1,14 @@
|
|||
use li_cdata_carrays;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Test::More tests => 4;
|
||||
BEGIN { use_ok('li_cdata_carrays') }
|
||||
require_ok('li_cdata_carrays');
|
||||
|
||||
$a = li_cdata_carrays::intArray->new(5);
|
||||
my $ia = li_cdata_carrays::intArray->new(5);
|
||||
for (0..4) {
|
||||
$a->setitem($_, $_**2);
|
||||
}
|
||||
$x = pack q{I5}, map $_**2, (0..4);
|
||||
$y = li_cdata_carrays::cdata_int($a->cast, 5);
|
||||
if ( $x ne $y ) {
|
||||
die "$x vs $y";
|
||||
$ia->setitem($_, $_**2);
|
||||
}
|
||||
ok(1, "setitems");
|
||||
my $x = pack q{I5}, map $_**2, (0..4);
|
||||
my $y = li_cdata_carrays::cdata_int($ia->cast, 5);
|
||||
is($x, $y, "carrays");
|
||||
|
|
|
|||
46
Examples/test-suite/perl5/li_std_except_runme.pl
Executable file
46
Examples/test-suite/perl5/li_std_except_runme.pl
Executable file
|
|
@ -0,0 +1,46 @@
|
|||
#!/usr/bin/perl
|
||||
use strict;
|
||||
use warnings;
|
||||
use Test::More tests => 22;
|
||||
BEGIN { use_ok('li_std_except') }
|
||||
require_ok('li_std_except');
|
||||
|
||||
# adapted from ../java/li_std_except_runme.java
|
||||
|
||||
# these are not prescriptive tests, they just match the error classes I
|
||||
# found are currently being issued, we may want to provide a more
|
||||
# granular error api later, so don't let these tests stop code
|
||||
# improvements.
|
||||
|
||||
my $test = new li_std_except::Test();
|
||||
eval { $test->throw_bad_exception() };
|
||||
like($@, qr/\bSystemError\b/, "throw_bad_exception");
|
||||
eval { $test->throw_domain_error() };
|
||||
like($@, qr/\bValueError\b/, "throw_domain_error");
|
||||
like($@, qr/\boops\b/, "throw_domain_error message");
|
||||
eval { $test->throw_exception() };
|
||||
like($@, qr/\bSystemError\b/, "throw_exception");
|
||||
eval { $test->throw_invalid_argument() };
|
||||
like($@, qr/\bValueError\b/, "throw_invalid_argument");
|
||||
like($@, qr/\boops\b/, "throw_invalid_argument message");
|
||||
eval { $test->throw_length_error() };
|
||||
like($@, qr/\bIndexError\b/, "throw_length_error");
|
||||
like($@, qr/\boops\b/, "throw_length_error message");
|
||||
eval { $test->throw_logic_error() };
|
||||
like($@, qr/\bRuntimeError\b/, "throw_logic_error");
|
||||
like($@, qr/\boops\b/, "throw_logic_error message");
|
||||
eval { $test->throw_out_of_range() };
|
||||
like($@, qr/\bIndexError\b/, "throw_out_of_range");
|
||||
like($@, qr/\boops\b/, "throw_out_of_range message");
|
||||
eval { $test->throw_overflow_error() };
|
||||
like($@, qr/\bOverflowError\b/, "throw_overflow_error");
|
||||
like($@, qr/\boops\b/, "throw_overflow_error message");
|
||||
eval { $test->throw_range_error() };
|
||||
like($@, qr/\bOverflowError\b/, "throw_range_error");
|
||||
like($@, qr/\boops\b/, "throw_range_error message");
|
||||
eval { $test->throw_runtime_error() };
|
||||
like($@, qr/\bRuntimeError\b/, "throw_runtime_error");
|
||||
like($@, qr/\boops\b/, "throw_runtime_error message");
|
||||
eval { $test->throw_underflow_error() };
|
||||
like($@, qr/\bOverflowError\b/, "throw_underflow_error");
|
||||
like($@, qr/\boops\b/, "throw_underflow_error message");
|
||||
|
|
@ -1,35 +1,30 @@
|
|||
use li_std_string;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use Test::More tests => 30;
|
||||
BEGIN { use_ok('li_std_string') }
|
||||
require_ok('li_std_string');
|
||||
|
||||
use Devel::Peek;
|
||||
# Checking expected use of %typemap(in) std::string {}
|
||||
li_std_string::test_value("Fee");
|
||||
|
||||
# Checking expected result of %typemap(out) std::string {}
|
||||
if (li_std_string::test_value("Fi") ne "Fi") {
|
||||
die "Test 1 failed";
|
||||
}
|
||||
is(li_std_string::test_value("Fi"), "Fi", "Test 1");
|
||||
|
||||
|
||||
###### passing undef seems to work - surely it should fail ????
|
||||
# Verify type-checking for %typemap(in) std::string {}
|
||||
#eval { li_std_string::test_value(undef) };
|
||||
#if (!$@) {
|
||||
# die "Test 2 failed";
|
||||
#}
|
||||
eval { li_std_string::test_value(undef) };
|
||||
like($@, qr/\bTypeError\b/, "Test 2");
|
||||
|
||||
# Checking expected use of %typemap(in) const std::string & {}
|
||||
li_std_string::test_const_reference("Fo");
|
||||
|
||||
# Checking expected result of %typemap(out) const std::string& {}
|
||||
if (li_std_string::test_const_reference("Fum") ne "Fum") {
|
||||
die "Test 3 failed";
|
||||
}
|
||||
is(li_std_string::test_const_reference("Fum"), "Fum", "Test 3");
|
||||
|
||||
###### passing undef seems to work - surely it should fail ????
|
||||
# Verify type-checking for %typemap(in) const std::string & {}
|
||||
#eval { li_std_string::test_const_reference(undef) };
|
||||
#if (!$@) {
|
||||
# die "Test 4 failed";
|
||||
#}
|
||||
eval { li_std_string::test_const_reference(undef) };
|
||||
like($@, qr/\bValueError\b/, "Test 4");
|
||||
|
||||
#
|
||||
# Input and output typemaps for pointers and non-const references to
|
||||
|
|
@ -53,102 +48,66 @@ li_std_string::test_reference($stringPtr);
|
|||
|
||||
# Check throw exception specification
|
||||
eval { li_std_string::test_throw() };
|
||||
if (!$@) {
|
||||
die "Test 5 failed";
|
||||
}
|
||||
is($@, "test_throw message", "Test 5");
|
||||
{ local $TODO = "why is the error not a Perl string?";
|
||||
eval { li_std_string::test_const_reference_throw() };
|
||||
if (!$@) {
|
||||
die "Test 6 failed";
|
||||
is($@, "<some kind of string>", "Test 6");
|
||||
}
|
||||
|
||||
# Global variables
|
||||
$s = "initial string";
|
||||
if ($li_std_string::GlobalString2 ne "global string 2") {
|
||||
die ("GlobalString2 test 1");
|
||||
}
|
||||
my $s = "initial string";
|
||||
is($li_std_string::GlobalString2, "global string 2", "GlobalString2 test 1");
|
||||
$li_std_string::GlobalString2 = $s;
|
||||
if ($li_std_string::GlobalString2 ne $s) {
|
||||
die ("GlobalString2 test 2");
|
||||
}
|
||||
if ($li_std_string::ConstGlobalString ne "const global string") {
|
||||
die ("ConstGlobalString test");
|
||||
}
|
||||
is($li_std_string::GlobalString2, $s, "GlobalString2 test 2");
|
||||
is($li_std_string::ConstGlobalString, "const global string", "ConstGlobalString test");
|
||||
|
||||
# Member variables
|
||||
$myStructure = new li_std_string::Structure();
|
||||
if ($myStructure->{MemberString2} ne "member string 2") {
|
||||
die ("MemberString2 test 1");
|
||||
}
|
||||
my $myStructure = new li_std_string::Structure();
|
||||
is($myStructure->{MemberString2}, "member string 2", "MemberString2 test 1");
|
||||
$myStructure->{MemberString2} = $s;
|
||||
if ($myStructure->{MemberString2} ne $s) {
|
||||
die ("MemberString2 test 2");
|
||||
}
|
||||
if ($myStructure->{ConstMemberString} ne "const member string") {
|
||||
die ("ConstMemberString test");
|
||||
}
|
||||
is($myStructure->{MemberString2}, $s, "MemberString2 test 2");
|
||||
is($myStructure->{ConstMemberString}, "const member string", "ConstMemberString test");
|
||||
|
||||
if ($li_std_string::Structure::StaticMemberString2 ne "static member string 2") {
|
||||
die ("StaticMemberString2 test 1");
|
||||
}
|
||||
is($li_std_string::Structure::StaticMemberString2, "static member string 2", "StaticMemberString2 test 1");
|
||||
$li_std_string::Structure::StaticMemberString2 = $s;
|
||||
if ($li_std_string::Structure::StaticMemberString2 ne $s) {
|
||||
die ("StaticMemberString2 test 2");
|
||||
}
|
||||
if ($li_std_string::Structure::ConstStaticMemberString ne "const static member string") {
|
||||
die ("ConstStaticMemberString test");
|
||||
}
|
||||
is($li_std_string::Structure::StaticMemberString2, $s, "StaticMemberString2 test 2");
|
||||
is($li_std_string::Structure::ConstStaticMemberString, "const static member string", "ConstStaticMemberString test");
|
||||
|
||||
if (li_std_string::test_reference_input("hello") ne "hello") {
|
||||
die ("reference_input");
|
||||
}
|
||||
is(li_std_string::test_reference_input("hello"), "hello", "reference_input");
|
||||
|
||||
if (li_std_string::test_reference_inout("hello") ne "hellohello") {
|
||||
die ("reference_inout");
|
||||
}
|
||||
is(li_std_string::test_reference_inout("hello"), "hellohello", "reference_inout");
|
||||
|
||||
|
||||
$gen1 = new li_std_string::Foo();
|
||||
if ($gen1->test(1) ne 2) {
|
||||
die ("ulonglong");
|
||||
}
|
||||
if ($gen1->test("1") ne "11") {
|
||||
die ("ulonglong");
|
||||
}
|
||||
if ($gen1->testl(12345) ne 12346) {
|
||||
die ("ulonglong small number");
|
||||
}
|
||||
no strict;
|
||||
my $gen1 = new li_std_string::Foo();
|
||||
is($gen1->test(1), 2, "ulonglong");
|
||||
is($gen1->test("1"), "11", "ulonglong");
|
||||
is($gen1->testl(12345), 12346, "ulonglong small number");
|
||||
# Note: 32 bit builds of perl will fail this test as the number is stored internally in scientific notation
|
||||
# (USE_64_BIT_ALL probably needs defining when building Perl in order to avoid this)
|
||||
#if ($gen1->testl(9234567890121111113) ne 9234567890121111114) {
|
||||
# die ("ulonglong big number");
|
||||
#}
|
||||
if ($gen1->testl("9234567890121111113") ne "9234567890121111114") {
|
||||
die ("ulonglong big number");
|
||||
SKIP: {
|
||||
skip "this Perl does not seem to do 64 bit ints", 1
|
||||
if 9234567890121111114 - 9234567890121111113 != 1;
|
||||
local $TODO;
|
||||
use Config;
|
||||
$TODO = "if we're lucky this might work" unless $Config{use64bitall};
|
||||
is(eval { $gen1->testl(9234567890121111113) }, 9234567890121111114, "ulonglong big number");
|
||||
# TODO: I suspect we can get by with "use64bitint", but I'll have to
|
||||
# work that out later. -talby
|
||||
}
|
||||
is($gen1->testl("9234567890121111113"), "9234567890121111114", "ulonglong big number");
|
||||
|
||||
|
||||
if (li_std_string::empty() ne "") {
|
||||
die ("empty");
|
||||
}
|
||||
is(li_std_string::empty(), "", "empty");
|
||||
|
||||
if (li_std_string::c_empty() ne "") {
|
||||
die ("c_empty");
|
||||
}
|
||||
is(li_std_string::c_empty(), "", "c_empty");
|
||||
|
||||
|
||||
if (li_std_string::c_null() ne undef) {
|
||||
die ("c_empty");
|
||||
}
|
||||
is(li_std_string::c_null(), undef, "c_empty");
|
||||
|
||||
|
||||
if (li_std_string::get_null(li_std_string::c_null()) ne undef) {
|
||||
die ("c_empty");
|
||||
}
|
||||
is(li_std_string::get_null(li_std_string::c_null()), undef, "c_empty");
|
||||
|
||||
if (li_std_string::get_null(li_std_string::c_empty()) ne "non-null") {
|
||||
die ("c_empty");
|
||||
}
|
||||
is(li_std_string::get_null(li_std_string::c_empty()), "non-null", "c_empty");
|
||||
|
||||
if (li_std_string::get_null(li_std_string::empty()) ne "non-null") {
|
||||
die ("c_empty");
|
||||
}
|
||||
is(li_std_string::get_null(li_std_string::empty()), "non-null", "c_empty");
|
||||
|
|
|
|||
77
Examples/test-suite/perl5/li_typemaps_runme.pl
Normal file
77
Examples/test-suite/perl5/li_typemaps_runme.pl
Normal file
|
|
@ -0,0 +1,77 @@
|
|||
#!/usr/bin/perl
|
||||
use strict;
|
||||
use warnings;
|
||||
use Test::More tests => 415;
|
||||
BEGIN { use_ok('li_typemaps') }
|
||||
require_ok('li_typemaps');
|
||||
|
||||
sub batch { my($type, @values) = @_;
|
||||
# this is a little ugly because I'm trying to be clever and save my
|
||||
# wrists from hammering out all these tests.
|
||||
for my $val (@values) {
|
||||
for my $tst (qw(
|
||||
in inr
|
||||
out outr
|
||||
inout inoutr
|
||||
)) {
|
||||
my $func = $tst . '_' . $type;
|
||||
is(eval { li_typemaps->can($func)->($val) }, $val, "$func $val");
|
||||
if($@) {
|
||||
my $err = $@;
|
||||
$err =~ s/^/#\$\@# /mg;
|
||||
print $err;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
batch('bool', '', 1);
|
||||
# let's assume we're at least on a 32 bit machine
|
||||
batch('int', -0x80000000, -1, 0, 1, 12, 0x7fffffff);
|
||||
# long could be bigger, but it's at least this big
|
||||
batch('long', -0x80000000, -1, 0, 1, 12, 0x7fffffff);
|
||||
batch('short', -0x8000, -1, 0, 1, 12, 0x7fff);
|
||||
batch('uint', 0, 1, 12, 0xffffffff);
|
||||
batch('ushort', 0, 1, 12, 0xffff);
|
||||
batch('ulong', 0, 1, 12, 0xffffffff);
|
||||
batch('uchar', 0, 1, 12, 0xff);
|
||||
batch('schar', -0x80, 0, 1, 12, 0x7f);
|
||||
|
||||
# IEEE 754 machine, please!
|
||||
batch('float',
|
||||
-(2 - 2 ** -23) * 2 ** 127,
|
||||
-1, -2 ** -149, 0, 2 ** -149, 1,
|
||||
(2 - 2 ** -23) * 2 ** 127,
|
||||
'nan');
|
||||
{ local $TODO = "shouldn't some Inf <=> float work?";
|
||||
# I'm going to guess that it could work reasonably as
|
||||
# NV Inf => float Inf
|
||||
# float Inf => NV NaN
|
||||
# but this needs some thought.
|
||||
batch('float', 'inf');
|
||||
}
|
||||
batch('double',
|
||||
-(2 - 2 ** -53) ** 1023,
|
||||
-1, -2 ** -1074, 0, 2 ** 1074,
|
||||
(2 - 2 ** -53) ** 1023,
|
||||
'nan', 'inf');
|
||||
batch('longlong', -1, 0, 1, 12);
|
||||
batch('ulonglong', 0, 1, 12);
|
||||
SKIP: {
|
||||
my $a = "8000000000000000";
|
||||
my $b = "7fffffffffffffff";
|
||||
my $c = "ffffffffffffffff";
|
||||
skip "not a 64bit Perl", 18 unless eval { pack 'q', 1 };
|
||||
batch('longlong', -hex($a), hex($b));
|
||||
batch('ulonglong', hex($c));
|
||||
}
|
||||
|
||||
my($foo, $int) = li_typemaps::out_foo(10);
|
||||
isa_ok($foo, 'li_typemaps::Foo');
|
||||
is($foo->{a}, 10);
|
||||
is($int, 20);
|
||||
|
||||
my($a, $b) = li_typemaps::inoutr_int2(13, 31);
|
||||
is($a, 13);
|
||||
is($b, 31);
|
||||
|
||||
|
|
@ -1,7 +1,10 @@
|
|||
|
||||
use strict;
|
||||
use warnings;
|
||||
use Test::More tests => 9;
|
||||
# member_pointer using pointers to member functions
|
||||
|
||||
use member_pointer;
|
||||
BEGIN { use_ok('member_pointer') }
|
||||
require_ok('member_pointer');
|
||||
|
||||
sub check($;$;$) {
|
||||
my($what, $expected, $actual) = @_;
|
||||
|
|
@ -12,29 +15,30 @@ sub check($;$;$) {
|
|||
|
||||
# Get the pointers
|
||||
|
||||
$area_pt = member_pointer::areapt();
|
||||
$perim_pt = member_pointer::perimeterpt();
|
||||
my $area_pt = member_pointer::areapt();
|
||||
my $perim_pt = member_pointer::perimeterpt();
|
||||
|
||||
# Create some objects
|
||||
|
||||
$s = new member_pointer::Square(10);
|
||||
my $s = new member_pointer::Square(10);
|
||||
|
||||
# Do some calculations
|
||||
|
||||
check "Square area ", 100.0, member_pointer::do_op($s,$area_pt);
|
||||
check "Square perim", 40.0, member_pointer::do_op($s,$perim_pt);
|
||||
is(100.0, member_pointer::do_op($s,$area_pt), "Square area");
|
||||
is(40.0, member_pointer::do_op($s,$perim_pt), "Square perim");
|
||||
no strict;
|
||||
|
||||
$memberPtr = $member_pointer::areavar;
|
||||
my $memberPtr = $member_pointer::areavar;
|
||||
$memberPtr = $member_pointer::perimetervar;
|
||||
|
||||
# Try the variables
|
||||
check "Square area ", 100.0, member_pointer::do_op($s,$member_pointer::areavar);
|
||||
check "Square perim", 40.0, member_pointer::do_op($s,$member_pointer::perimetervar);
|
||||
is(100.0, member_pointer::do_op($s,$member_pointer::areavar), "Square area");
|
||||
is(40.0, member_pointer::do_op($s,$member_pointer::perimetervar), "Square perim");
|
||||
|
||||
# Modify one of the variables
|
||||
$member_pointer::areavar = $perim_pt;
|
||||
|
||||
check "Square perimeter", 40.0, member_pointer::do_op($s,$member_pointer::areavar);
|
||||
is(40.0, member_pointer::do_op($s,$member_pointer::areavar), "Square perimeter");
|
||||
|
||||
# Try the constants
|
||||
|
||||
|
|
@ -42,6 +46,6 @@ $memberPtr = $member_pointer::AREAPT;
|
|||
$memberPtr = $member_pointer::PERIMPT;
|
||||
$memberPtr = $member_pointer::NULLPT;
|
||||
|
||||
check "Square area ", 100.0, member_pointer::do_op($s,$member_pointer::AREAPT);
|
||||
check "Square perim", 40.0, member_pointer::do_op($s,$member_pointer::PERIMPT);
|
||||
is(100.0, member_pointer::do_op($s,$member_pointer::AREAPT), "Square area");
|
||||
is(40.0, member_pointer::do_op($s,$member_pointer::PERIMPT), "Square perim");
|
||||
|
||||
|
|
|
|||
72
Examples/test-suite/perl5/minherit_runme.pl
Executable file
72
Examples/test-suite/perl5/minherit_runme.pl
Executable file
|
|
@ -0,0 +1,72 @@
|
|||
#!/usr/bin/perl
|
||||
use strict;
|
||||
use warnings;
|
||||
use Test::More tests => 38;
|
||||
BEGIN { use_ok('minherit') }
|
||||
require_ok('minherit');
|
||||
|
||||
# adapted from ../python/minherit_runme.py
|
||||
|
||||
my $a = minherit::Foo->new();
|
||||
my $b = minherit::Bar->new();
|
||||
my $c = minherit::FooBar->new();
|
||||
my $d = minherit::Spam->new();
|
||||
|
||||
is($a->xget(), 1);
|
||||
|
||||
is($b->yget(), 2);
|
||||
|
||||
is($c->xget(), 1);
|
||||
is($c->yget(), 2);
|
||||
is($c->zget(), 3);
|
||||
|
||||
is($d->xget(), 1);
|
||||
is($d->yget(), 2);
|
||||
is($d->zget(), 3);
|
||||
is($d->wget(), 4);
|
||||
|
||||
is(minherit::xget($a), 1);
|
||||
|
||||
is(minherit::yget($b), 2);
|
||||
|
||||
is(minherit::xget($c), 1);
|
||||
is(minherit::yget($c), 2);
|
||||
is(minherit::zget($c), 3);
|
||||
|
||||
is(minherit::xget($d), 1);
|
||||
is(minherit::yget($d), 2);
|
||||
is(minherit::zget($d), 3);
|
||||
is(minherit::wget($d), 4);
|
||||
|
||||
# Cleanse all of the pointers and see what happens
|
||||
|
||||
my $aa = minherit::toFooPtr($a);
|
||||
my $bb = minherit::toBarPtr($b);
|
||||
my $cc = minherit::toFooBarPtr($c);
|
||||
my $dd = minherit::toSpamPtr($d);
|
||||
|
||||
is($aa->xget, 1);
|
||||
|
||||
is($bb->yget(), 2);
|
||||
|
||||
is($cc->xget(), 1);
|
||||
is($cc->yget(), 2);
|
||||
is($cc->zget(), 3);
|
||||
|
||||
is($dd->xget(), 1);
|
||||
is($dd->yget(), 2);
|
||||
is($dd->zget(), 3);
|
||||
is($dd->wget(), 4);
|
||||
|
||||
is(minherit::xget($aa), 1);
|
||||
|
||||
is(minherit::yget($bb), 2);
|
||||
|
||||
is(minherit::xget($cc), 1);
|
||||
is(minherit::yget($cc), 2);
|
||||
is(minherit::zget($cc), 3);
|
||||
|
||||
is(minherit::xget($dd), 1);
|
||||
is(minherit::yget($dd), 2);
|
||||
is(minherit::zget($dd), 3);
|
||||
is(minherit::wget($dd), 4);
|
||||
|
|
@ -1,15 +1,12 @@
|
|||
use strict;
|
||||
use warnings;
|
||||
use Test::More tests => 5;
|
||||
BEGIN { use_ok('multiple_inheritance') }
|
||||
require_ok('multiple_inheritance');
|
||||
|
||||
use multiple_inheritance;
|
||||
my $fooBar = new multiple_inheritance::FooBar();
|
||||
is($fooBar->foo(), 2, "Runtime test1");
|
||||
|
||||
$fooBar = new multiple_inheritance::FooBar();
|
||||
if ($fooBar->foo() != 2) {
|
||||
die "Runtime test1 failed\n";
|
||||
}
|
||||
is($fooBar->bar(), 1, "Runtime test2");
|
||||
|
||||
if ($fooBar->bar() != 1) {
|
||||
die "Runtime test2 failed\n";
|
||||
}
|
||||
|
||||
if ($fooBar->fooBar() != 3) {
|
||||
die "Runtime test3 failed\n";
|
||||
}
|
||||
is($fooBar->fooBar(), 3, "Runtime test3 ");
|
||||
|
|
|
|||
22
Examples/test-suite/perl5/naturalvar_runme.pl
Executable file
22
Examples/test-suite/perl5/naturalvar_runme.pl
Executable file
|
|
@ -0,0 +1,22 @@
|
|||
#!/usr/bin/perl
|
||||
use strict;
|
||||
use warnings;
|
||||
use Test::More tests => 5;
|
||||
BEGIN { use_ok('naturalvar') }
|
||||
require_ok('naturalvar');
|
||||
|
||||
# adapted from ../python/naturalvar_runme.py
|
||||
|
||||
my $f = naturalvar::Foo->new();
|
||||
isa_ok($f, 'naturalvar::Foo');
|
||||
my $b = naturalvar::Bar->new();
|
||||
isa_ok($b, 'naturalvar::Bar');
|
||||
|
||||
$b->{f} = $f;
|
||||
|
||||
$naturalvar::s = "hello";
|
||||
|
||||
$b->{s} = "hello";
|
||||
|
||||
is($naturalvar::s, $b->{s});
|
||||
|
||||
14
Examples/test-suite/perl5/preproc_runme.pl
Executable file
14
Examples/test-suite/perl5/preproc_runme.pl
Executable file
|
|
@ -0,0 +1,14 @@
|
|||
#!/usr/bin/perl
|
||||
use strict;
|
||||
use warnings;
|
||||
use Test::More tests => 6;
|
||||
BEGIN { use_ok('preproc') }
|
||||
require_ok('preproc');
|
||||
|
||||
# adapted from ../python/preproc_runme.py
|
||||
|
||||
is($preproc::endif, 1);
|
||||
is($preproc::define, 1);
|
||||
is($preproc::defined, 1);
|
||||
is($preproc::one * 2, $preproc::two);
|
||||
|
||||
|
|
@ -1,38 +1,18 @@
|
|||
use primitive_ref;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Test::More tests => 14;
|
||||
BEGIN { use_ok('primitive_ref') }
|
||||
require_ok('primitive_ref');
|
||||
|
||||
if (primitive_ref::ref_int(3) != 3) {
|
||||
die "ref_int failed!\n";
|
||||
}
|
||||
if (primitive_ref::ref_uint(3) != 3) {
|
||||
die "ref_uint failed!\n";
|
||||
}
|
||||
if (primitive_ref::ref_short(3) != 3) {
|
||||
die "ref_short failed!\n";
|
||||
}
|
||||
if (primitive_ref::ref_ushort(3) != 3) {
|
||||
die "ref_ushort failed!\n";
|
||||
}
|
||||
if (primitive_ref::ref_long(3) != 3) {
|
||||
die "ref_long failed!\n";
|
||||
}
|
||||
if (primitive_ref::ref_ulong(3) != 3) {
|
||||
die "ref_ulong failed!\n";
|
||||
}
|
||||
if (primitive_ref::ref_schar(3) != 3) {
|
||||
die "ref_schar failed!\n";
|
||||
}
|
||||
if (primitive_ref::ref_uchar(3) != 3) {
|
||||
die "ref_uchar failed!\n";
|
||||
}
|
||||
if (primitive_ref::ref_bool(1) != 1) {
|
||||
die "ref_bool failed!\n";
|
||||
}
|
||||
if (primitive_ref::ref_float(3.5) != 3.5) {
|
||||
die "ref_float failed!\n";
|
||||
}
|
||||
if (primitive_ref::ref_double(3.5) != 3.5) {
|
||||
die "ref_double failed!\n";
|
||||
}
|
||||
if (primitive_ref::ref_char('x') != 'x') {
|
||||
die "ref_char failed!\n";
|
||||
}
|
||||
is(primitive_ref::ref_int(3), 3, "ref_int");
|
||||
is(primitive_ref::ref_uint(3), 3, "ref_uint");
|
||||
is(primitive_ref::ref_short(3), 3, "ref_short");
|
||||
is(primitive_ref::ref_ushort(3), 3, "ref_ushort");
|
||||
is(primitive_ref::ref_long(3), 3, "ref_long");
|
||||
is(primitive_ref::ref_ulong(3), 3, "ref_ulong");
|
||||
is(primitive_ref::ref_schar(3), 3, "ref_schar");
|
||||
is(primitive_ref::ref_uchar(3), 3, "ref_uchar");
|
||||
is(primitive_ref::ref_bool(1), 1, "ref_bool");
|
||||
is(primitive_ref::ref_float(3.5), 3.5, "ref_float");
|
||||
is(primitive_ref::ref_double(3.5), 3.5, "ref_double");
|
||||
is(primitive_ref::ref_char('x'), 'x', "ref_char");
|
||||
|
|
|
|||
282
Examples/test-suite/perl5/primitive_types_runme.pl
Executable file
282
Examples/test-suite/perl5/primitive_types_runme.pl
Executable file
|
|
@ -0,0 +1,282 @@
|
|||
use strict;
|
||||
use warnings;
|
||||
use Test::More tests => 54;
|
||||
BEGIN { use_ok('primitive_types') }
|
||||
require_ok('primitive_types');
|
||||
|
||||
primitive_types::var_init();
|
||||
|
||||
# assigning globals calls
|
||||
$primitive_types::var_bool = $primitive_types::sct_bool;
|
||||
$primitive_types::var_schar = $primitive_types::sct_schar;
|
||||
$primitive_types::var_uchar = $primitive_types::sct_uchar;
|
||||
$primitive_types::var_int = $primitive_types::sct_int;
|
||||
$primitive_types::var_uint = $primitive_types::sct_uint;
|
||||
$primitive_types::var_short = $primitive_types::sct_short;
|
||||
$primitive_types::var_ushort = $primitive_types::sct_ushort;
|
||||
$primitive_types::var_long = $primitive_types::sct_long;
|
||||
$primitive_types::var_ulong = $primitive_types::sct_ulong;
|
||||
$primitive_types::var_llong = $primitive_types::sct_llong;
|
||||
$primitive_types::var_ullong = $primitive_types::sct_ullong;
|
||||
$primitive_types::var_char = $primitive_types::sct_char;
|
||||
$primitive_types::var_pchar = $primitive_types::sct_pchar;
|
||||
$primitive_types::var_pcharc = $primitive_types::sct_pcharc;
|
||||
$primitive_types::var_pint = $primitive_types::sct_pint;
|
||||
$primitive_types::var_sizet = $primitive_types::sct_sizet;
|
||||
$primitive_types::var_hello = $primitive_types::sct_hello;
|
||||
$primitive_types::var_myint = $primitive_types::sct_myint;
|
||||
$primitive_types::var_namet = $primitive_types::def_namet;
|
||||
$primitive_types::var_parami = $primitive_types::sct_parami;
|
||||
$primitive_types::var_paramd = $primitive_types::sct_paramd;
|
||||
$primitive_types::var_paramc = $primitive_types::sct_paramc;
|
||||
|
||||
ok(primitive_types::v_check(), "v_check");
|
||||
|
||||
#def pyerror(name, val, cte):
|
||||
# print "bad val/cte", name, val, cte
|
||||
# raise RuntimeError
|
||||
# pass
|
||||
|
||||
is($primitive_types::var_bool, $primitive_types::cct_bool, "bool");
|
||||
is($primitive_types::var_schar, $primitive_types::cct_schar, "schar");
|
||||
is($primitive_types::var_uchar, $primitive_types::cct_uchar, "uchar");
|
||||
is($primitive_types::var_int, $primitive_types::cct_int, "int");
|
||||
is($primitive_types::var_uint, $primitive_types::cct_uint, "uint");
|
||||
is($primitive_types::var_short, $primitive_types::cct_short, "short");
|
||||
is($primitive_types::var_ushort, $primitive_types::cct_ushort, "ushort");
|
||||
is($primitive_types::var_long, $primitive_types::cct_long, "long");
|
||||
is($primitive_types::var_ulong, $primitive_types::cct_ulong, "ulong");
|
||||
is($primitive_types::var_llong, $primitive_types::cct_llong, "llong");
|
||||
is($primitive_types::var_ullong, $primitive_types::cct_ullong, "ullong");
|
||||
is($primitive_types::var_char, $primitive_types::cct_char, "char");
|
||||
is($primitive_types::var_pchar, $primitive_types::cct_pchar, "pchar");
|
||||
is($primitive_types::var_pcharc, $primitive_types::cct_pcharc, "pchar");
|
||||
is($primitive_types::var_pint, $primitive_types::cct_pint, "pint");
|
||||
is($primitive_types::var_sizet, $primitive_types::cct_sizet, "sizet");
|
||||
is($primitive_types::var_hello, $primitive_types::cct_hello, "hello");
|
||||
is($primitive_types::var_myint, $primitive_types::cct_myint, "myint");
|
||||
is($primitive_types::var_namet, $primitive_types::def_namet, "name");
|
||||
|
||||
#class PyTest (TestDirector):
|
||||
# def __init__(self):
|
||||
# TestDirector.__init__(self)
|
||||
# pass
|
||||
# def ident(self, x):
|
||||
# return x
|
||||
#
|
||||
# def vval_bool(self, x): return self.ident(x)
|
||||
# def vval_schar(self, x): return self.ident(x)
|
||||
# def vval_uchar(self, x): return self.ident(x)
|
||||
# def vval_int(self, x): return self.ident(x)
|
||||
# def vval_uint(self, x): return self.ident(x)
|
||||
# def vval_short(self, x): return self.ident(x)
|
||||
# def vval_ushort(self, x): return self.ident(x)
|
||||
# def vval_long(self, x): return self.ident(x)
|
||||
# def vval_ulong(self, x): return self.ident(x)
|
||||
# def vval_llong(self, x): return self.ident(x)
|
||||
# def vval_ullong(self, x): return self.ident(x)
|
||||
# def vval_float(self, x): return self.ident(x)
|
||||
# def vval_double(self, x): return self.ident(x)
|
||||
# def vval_char(self, x): return self.ident(x)
|
||||
# def vval_pchar(self, x): return self.ident(x)
|
||||
# def vval_pcharc(self, x): return self.ident(x)
|
||||
# def vval_pint(self, x): return self.ident(x)
|
||||
# def vval_sizet(self, x): return self.ident(x)
|
||||
# def vval_hello(self, x): return self.ident(x)
|
||||
# def vval_myint(self, x): return self.ident(x)
|
||||
#
|
||||
# def vref_bool(self, x): return self.ident(x)
|
||||
# def vref_schar(self, x): return self.ident(x)
|
||||
# def vref_uchar(self, x): return self.ident(x)
|
||||
# def vref_int(self, x): return self.ident(x)
|
||||
# def vref_uint(self, x): return self.ident(x)
|
||||
# def vref_short(self, x): return self.ident(x)
|
||||
# def vref_ushort(self, x): return self.ident(x)
|
||||
# def vref_long(self, x): return self.ident(x)
|
||||
# def vref_ulong(self, x): return self.ident(x)
|
||||
# def vref_llong(self, x): return self.ident(x)
|
||||
# def vref_ullong(self, x): return self.ident(x)
|
||||
# def vref_float(self, x): return self.ident(x)
|
||||
# def vref_double(self, x): return self.ident(x)
|
||||
# def vref_char(self, x): return self.ident(x)
|
||||
# def vref_pchar(self, x): return self.ident(x)
|
||||
# def vref_pcharc(self, x): return self.ident(x)
|
||||
# def vref_pint(self, x): return self.ident(x)
|
||||
# def vref_sizet(self, x): return self.ident(x)
|
||||
# def vref_hello(self, x): return self.ident(x)
|
||||
# def vref_myint(self, x): return self.ident(x)
|
||||
#
|
||||
# pass
|
||||
|
||||
|
||||
my $t = primitive_types::Test->new();
|
||||
#p = PyTest()
|
||||
#
|
||||
#
|
||||
# internal call check
|
||||
#if t.c_check() != p.c_check():
|
||||
# raise RuntimeError, "bad director"
|
||||
#
|
||||
#p.var_bool = p.stc_bool
|
||||
#p.var_schar = p.stc_schar
|
||||
#p.var_uchar = p.stc_uchar
|
||||
#p.var_int = p.stc_int
|
||||
#p.var_uint = p.stc_uint
|
||||
#p.var_short = p.stc_short
|
||||
#p.var_ushort = p.stc_ushort
|
||||
#p.var_long = p.stc_long
|
||||
#p.var_ulong = p.stc_ulong
|
||||
#p.var_llong = p.stc_llong
|
||||
#p.var_ullong = p.stc_ullong
|
||||
#p.var_char = p.stc_char
|
||||
#p.var_pchar = sct_pchar
|
||||
#p.var_pcharc = sct_pcharc
|
||||
#p.var_pint = sct_pint
|
||||
#p.var_sizet = sct_sizet
|
||||
#p.var_hello = sct_hello
|
||||
#p.var_myint = sct_myint
|
||||
#p.var_namet = def_namet
|
||||
#p.var_parami = sct_parami
|
||||
#p.var_paramd = sct_paramd
|
||||
#p.var_paramc = sct_paramc
|
||||
#
|
||||
#p.v_check()
|
||||
|
||||
$t->{var_bool} = $primitive_types::Test::stc_bool;
|
||||
$t->{var_schar} = $primitive_types::Test::stc_schar;
|
||||
$t->{var_uchar} = $primitive_types::Test::stc_uchar;
|
||||
$t->{var_int} = $primitive_types::Test::stc_int;
|
||||
$t->{var_uint} = $primitive_types::Test::stc_uint;
|
||||
$t->{var_short} = $primitive_types::Test::stc_short;
|
||||
$t->{var_ushort} = $primitive_types::Test::stc_ushort;
|
||||
$t->{var_long} = $primitive_types::Test::stc_long;
|
||||
$t->{var_ulong} = $primitive_types::Test::stc_ulong;
|
||||
$t->{var_llong} = $primitive_types::Test::stc_llong;
|
||||
$t->{var_ullong} = $primitive_types::Test::stc_ullong;
|
||||
$t->{var_char} = $primitive_types::Test::stc_char;
|
||||
$t->{var_pchar} = $primitive_types::sct_pchar;
|
||||
$t->{var_pcharc} = $primitive_types::sct_pcharc;
|
||||
$t->{var_pint} = $primitive_types::sct_pint;
|
||||
$t->{var_sizet} = $primitive_types::sct_sizet;
|
||||
$t->{var_hello} = $primitive_types::sct_hello;
|
||||
$t->{var_myint} = $primitive_types::sct_myint;
|
||||
$t->{var_namet} = $primitive_types::def_namet;
|
||||
$t->{var_parami} = $primitive_types::sct_parami;
|
||||
$t->{var_paramd} = $primitive_types::sct_paramd;
|
||||
$t->{var_paramc} = $primitive_types::sct_paramc;
|
||||
ok($t->v_check(), 'v_check');
|
||||
|
||||
is($primitive_types::def_namet, "ho\0la", "namet");
|
||||
$t->{var_namet} = $primitive_types::def_namet;
|
||||
is($t->{var_namet}, $primitive_types::def_namet, "namet");
|
||||
|
||||
$t->{var_namet} = 'holac';
|
||||
|
||||
is($t->{var_namet}, 'holac', "namet");
|
||||
|
||||
$t->{var_namet} = 'hol';
|
||||
|
||||
is($t->{var_namet}, 'hol', "namet");
|
||||
|
||||
|
||||
is($t->strlen('hile'), 4, "string typemap");
|
||||
|
||||
is($t->strlen("hil\0"), 4, "string typemap");
|
||||
|
||||
|
||||
$primitive_types::var_char = "\0";
|
||||
is($primitive_types::var_char, "\0", "char '0' case");
|
||||
|
||||
$primitive_types::var_char = 0;
|
||||
is($primitive_types::var_char, "\0", "char '0' case");
|
||||
|
||||
$primitive_types::var_namet = "\0";
|
||||
is($primitive_types::var_namet, '', "char '\\0' case");
|
||||
|
||||
$primitive_types::var_namet = '';
|
||||
is($primitive_types::var_namet, '', "char empty case");
|
||||
|
||||
$primitive_types::var_pchar = undef;
|
||||
is($primitive_types::var_pchar, undef, "undef case");
|
||||
|
||||
$primitive_types::var_pchar = '';
|
||||
is($primitive_types::var_pchar, '', "char empty case");
|
||||
|
||||
$primitive_types::var_pcharc = undef;
|
||||
is($primitive_types::var_pcharc, undef, "undef case");
|
||||
|
||||
$primitive_types::var_pcharc = '';
|
||||
is($primitive_types::var_pcharc, '', "char empty case");
|
||||
|
||||
|
||||
#
|
||||
# creating a raw char*
|
||||
#
|
||||
my $pc = primitive_types::new_pchar(5);
|
||||
primitive_types::pchar_setitem($pc, 0, 'h');
|
||||
primitive_types::pchar_setitem($pc, 1, 'o');
|
||||
primitive_types::pchar_setitem($pc, 2, 'l');
|
||||
primitive_types::pchar_setitem($pc, 3, 'a');
|
||||
primitive_types::pchar_setitem($pc, 4, 0);
|
||||
|
||||
|
||||
is($t->strlen($pc), 4, "string typemap");
|
||||
|
||||
$primitive_types::var_pchar = $pc;
|
||||
is($primitive_types::var_pchar, "hola", "pointer case");
|
||||
|
||||
$primitive_types::var_namet = $pc;
|
||||
is($primitive_types::var_namet, "hola", "pointer case");
|
||||
|
||||
primitive_types::delete_pchar($pc);
|
||||
|
||||
#
|
||||
# Now when things should fail
|
||||
#
|
||||
|
||||
{
|
||||
my $orig = $t->{var_uchar};
|
||||
eval { $t->{var_uchar} = 10000 };
|
||||
like($@, qr/\bOverflowError\b/, "uchar typemap");
|
||||
is($orig, $t->{var_uchar}, "uchar typemap");
|
||||
}
|
||||
{
|
||||
my $orig = $t->{var_char};
|
||||
#eval { $t->{var_char} = "23" }; Perl will gladly make a number out of that
|
||||
eval { $t->{var_char} = "twenty-three" };
|
||||
like($@, qr/\bTypeError\b/, "char typemap");
|
||||
is($orig, $t->{var_char}, "char typemap");
|
||||
}
|
||||
{
|
||||
my $orig = $t->{var_uint};
|
||||
eval { $t->{var_uint} = -1 };
|
||||
like($@, qr/\bOverflowError\b/, "uint typemap");
|
||||
is($orig, $t->{var_uint}, "uint typemap");
|
||||
}
|
||||
{
|
||||
my $orig = $t->{var_namet};
|
||||
eval { $t->{var_namet} = '123456' };
|
||||
like($@, qr/\bTypeError\b/, "namet typemap");
|
||||
is($orig, $t->{var_namet}, "namet typemap");
|
||||
}
|
||||
#t2 = p.vtest(t)
|
||||
#if t.var_namet != t2.var_namet:
|
||||
# raise RuntimeError, "bad SWIGTYPE* typemap"
|
||||
|
||||
is($primitive_types::fixsize, "ho\0la\0\0\0", "FIXSIZE typemap");
|
||||
|
||||
$primitive_types::fixsize = 'ho';
|
||||
is($primitive_types::fixsize, "ho\0\0\0\0\0\0", "FIXSIZE typemap");
|
||||
|
||||
|
||||
my $f = primitive_types::Foo->new(3);
|
||||
my $f1 = primitive_types::fptr_val($f);
|
||||
my $f2 = primitive_types::fptr_ref($f);
|
||||
is($f1->{_a}, $f2->{_a}, "const ptr& typemap");
|
||||
|
||||
|
||||
is(primitive_types::char_foo(1,3), 3, "int typemap");
|
||||
|
||||
is(primitive_types::char_foo(1,"hello"), "hello", "char* typemap");
|
||||
|
||||
is(primitive_types::SetPos(1,3), 4, "int typemap");
|
||||
80
Examples/test-suite/perl5/reference_global_vars_runme.pl
Executable file
80
Examples/test-suite/perl5/reference_global_vars_runme.pl
Executable file
|
|
@ -0,0 +1,80 @@
|
|||
#!/usr/bin/perl
|
||||
use strict;
|
||||
use warnings;
|
||||
use Test::More tests => 19;
|
||||
BEGIN { use_ok('reference_global_vars') }
|
||||
require_ok('reference_global_vars');
|
||||
|
||||
# adapted from ../python/reference_global_vars_runme.py
|
||||
|
||||
my $cvar;
|
||||
{
|
||||
# don't try this at home kids... sneaking an import of all symbols
|
||||
# from reference_global_vars to main because my fingers are getting
|
||||
# sore from qualifying all these names. ;)
|
||||
my $cvar = *reference_global_vars::;
|
||||
map { ${*::}{$_} = ${$cvar}{$_} } keys %{$cvar};
|
||||
}
|
||||
|
||||
is(getconstTC()->{num}, 33);
|
||||
|
||||
# primitive reference variables
|
||||
$cvar->{var_bool} = createref_bool(0);
|
||||
is(value_bool($cvar->{var_bool}), '');
|
||||
|
||||
$cvar->{var_bool} = createref_bool(1);
|
||||
is(value_bool($cvar->{var_bool}), 1);
|
||||
|
||||
$cvar->{var_char} = createref_char('w');
|
||||
is(value_char($cvar->{var_char}), 'w');
|
||||
|
||||
$cvar->{var_unsigned_char} = createref_unsigned_char(10);
|
||||
is(value_unsigned_char($cvar->{var_unsigned_char}), 10);
|
||||
|
||||
$cvar->{var_signed_char} = createref_signed_char(10);
|
||||
is(value_signed_char($cvar->{var_signed_char}), 10);
|
||||
|
||||
$cvar->{var_short} = createref_short(10);
|
||||
is(value_short($cvar->{var_short}), 10);
|
||||
|
||||
$cvar->{var_unsigned_short} = createref_unsigned_short(10);
|
||||
is(value_unsigned_short($cvar->{var_unsigned_short}), 10);
|
||||
|
||||
$cvar->{var_int} = createref_int(10);
|
||||
is(value_int($cvar->{var_int}), 10);
|
||||
|
||||
$cvar->{var_unsigned_int} = createref_unsigned_int(10);
|
||||
is(value_unsigned_int($cvar->{var_unsigned_int}), 10);
|
||||
|
||||
$cvar->{var_long} = createref_long(10);
|
||||
is(value_long($cvar->{var_long}), 10);
|
||||
|
||||
$cvar->{var_unsigned_long} = createref_unsigned_long(10);
|
||||
is(value_unsigned_long($cvar->{var_unsigned_long}), 10);
|
||||
|
||||
SKIP: {
|
||||
my $a = "6FFFFFFFFFFFFFF8";
|
||||
skip "64 bit int support", 1 unless eval { pack 'q', 1 };
|
||||
# using hex() here instead of a literal because non 64bit Perls will
|
||||
# be noisy about big constants.
|
||||
$cvar->{var_long_long} = createref_long_long(hex $a);
|
||||
is(value_long_long($cvar->{var_long_long}), hex $a);
|
||||
}
|
||||
|
||||
#ull = abs(0xFFFFFFF2FFFFFFF0)
|
||||
my $ull = 55834574864;
|
||||
$cvar->{var_unsigned_long_long} = createref_unsigned_long_long($ull);
|
||||
is(value_unsigned_long_long($cvar->{var_unsigned_long_long}), $ull);
|
||||
|
||||
$cvar->{var_float} = createref_float(10.5);
|
||||
is(value_float($cvar->{var_float}), 10.5);
|
||||
|
||||
$cvar->{var_double} = createref_double(10.5);
|
||||
is(value_double($cvar->{var_double}), 10.5);
|
||||
|
||||
# class reference variable
|
||||
$cvar->{var_TestClass} = createref_TestClass(
|
||||
TestClass->new(20)
|
||||
);
|
||||
is(value_TestClass($cvar->{var_TestClass})->{num}, 20);
|
||||
|
||||
15
Examples/test-suite/perl5/rename_scope_runme.pl
Executable file
15
Examples/test-suite/perl5/rename_scope_runme.pl
Executable file
|
|
@ -0,0 +1,15 @@
|
|||
#!/usr/bin/perl
|
||||
use strict;
|
||||
use warnings;
|
||||
use Test::More tests => 5;
|
||||
BEGIN { use_ok('rename_scope') }
|
||||
require_ok('rename_scope');
|
||||
|
||||
# adapted from ../python/rename_scope_runme.py
|
||||
|
||||
my $a = rename_scope::Natural_UP->new();
|
||||
is($a->rtest(), 1);
|
||||
my $b = rename_scope::Natural_BP->new();
|
||||
is($b->rtest(), 1);
|
||||
|
||||
isa_ok(rename_scope->can('equals'), 'CODE');
|
||||
12
Examples/test-suite/perl5/ret_by_value_runme.pl
Normal file
12
Examples/test-suite/perl5/ret_by_value_runme.pl
Normal file
|
|
@ -0,0 +1,12 @@
|
|||
#!/usr/bin/perl
|
||||
use strict;
|
||||
use warnings;
|
||||
use Test::More tests => 5;
|
||||
BEGIN { use_ok('ret_by_value') }
|
||||
require_ok('ret_by_value');
|
||||
|
||||
my $tst = ret_by_value::get_test();
|
||||
isa_ok($tst, 'ret_by_value::test');
|
||||
is($tst->{myInt}, 100);
|
||||
is($tst->{myShort}, 200);
|
||||
|
||||
13
Examples/test-suite/perl5/return_const_value_runme.pl
Executable file
13
Examples/test-suite/perl5/return_const_value_runme.pl
Executable file
|
|
@ -0,0 +1,13 @@
|
|||
#!/usr/bin/perl
|
||||
use strict;
|
||||
use warnings;
|
||||
use Test::More tests => 4;
|
||||
BEGIN { use_ok('return_const_value') }
|
||||
require_ok('return_const_value');
|
||||
|
||||
# adapted from ../python/return_const_value_runme.py
|
||||
|
||||
is(return_const_value::Foo_ptr::getPtr()->getVal(), 17);
|
||||
|
||||
is(return_const_value::Foo_ptr::getConstPtr()->getVal(), 17);
|
||||
|
||||
18
Examples/test-suite/perl5/sizet_runme.pl
Executable file
18
Examples/test-suite/perl5/sizet_runme.pl
Executable file
|
|
@ -0,0 +1,18 @@
|
|||
#!/usr/bin/perl
|
||||
use strict;
|
||||
use warnings;
|
||||
use Test::More tests => 6;
|
||||
BEGIN { use_ok('sizet') }
|
||||
require_ok('sizet');
|
||||
|
||||
# adapted from ../java/sizet_runme.java
|
||||
|
||||
my $s = 2000;
|
||||
$s = sizet::test1($s + 1);
|
||||
is($s, 2001, 'test1');
|
||||
$s = sizet::test1($s + 1);
|
||||
is($s, 2002, 'test2');
|
||||
$s = sizet::test1($s + 1);
|
||||
is($s, 2003, 'test3');
|
||||
$s = sizet::test1($s + 1);
|
||||
is($s, 2004, 'test4');
|
||||
13
Examples/test-suite/perl5/sneaky1_runme.pl
Executable file
13
Examples/test-suite/perl5/sneaky1_runme.pl
Executable file
|
|
@ -0,0 +1,13 @@
|
|||
#!/usr/bin/perl
|
||||
use strict;
|
||||
use warnings;
|
||||
use Test::More 'no_plan';
|
||||
BEGIN { use_ok('sneaky1') }
|
||||
require_ok('sneaky1');
|
||||
|
||||
# adapted from ../python/sneaky1_runme.py
|
||||
|
||||
is(sneaky1::add(3,4), 7);
|
||||
is(sneaky1::subtract(3,4), -1);
|
||||
is(sneaky1::mul(3,4), 12);
|
||||
is(sneaky1::divide(3,4), 0);
|
||||
|
|
@ -1,171 +1,111 @@
|
|||
use template_default_arg;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Test::More tests => 34;
|
||||
BEGIN { use_ok('template_default_arg') }
|
||||
require_ok('template_default_arg');
|
||||
|
||||
{
|
||||
$helloInt = new template_default_arg::Hello_int();
|
||||
my $helloInt = new template_default_arg::Hello_int();
|
||||
$helloInt->foo(0);
|
||||
}
|
||||
{
|
||||
$x = new template_default_arg::X_int();
|
||||
if ($x->meth(20.0, 200) != 200) {
|
||||
die "X_int test 1 failed";
|
||||
}
|
||||
if ($x->meth(20) != 20) {
|
||||
die "X_int test 2 failed";
|
||||
}
|
||||
if ($x->meth() != 0) {
|
||||
die "X_int test 3 failed";
|
||||
}
|
||||
my $x = new template_default_arg::X_int();
|
||||
is($x->meth(20.0, 200), 200, "X_int test 1");
|
||||
is($x->meth(20), 20, "X_int test 2");
|
||||
is($x->meth(), 0, "X_int test 3");
|
||||
}
|
||||
|
||||
{
|
||||
$y = new template_default_arg::Y_unsigned();
|
||||
if ($y->meth(20.0, 200) != 200) {
|
||||
die "Y_unsigned test 1 failed";
|
||||
}
|
||||
if ($y->meth(20) != 20) {
|
||||
die "Y_unsigned test 2 failed";
|
||||
}
|
||||
if ($y->meth() != 0) {
|
||||
die "Y_unsigned test 3 failed";
|
||||
}
|
||||
my $y = new template_default_arg::Y_unsigned();
|
||||
is($y->meth(20.0, 200), 200, "Y_unsigned test 1");
|
||||
is($y->meth(20), 20, "Y_unsigned test 2");
|
||||
is($y->meth(), 0, "Y_unsigned test 3");
|
||||
}
|
||||
|
||||
{
|
||||
$x = new template_default_arg::X_longlong();
|
||||
my $x = new template_default_arg::X_longlong();
|
||||
$x = new template_default_arg::X_longlong(20.0);
|
||||
$x = new template_default_arg::X_longlong(20.0, 200);
|
||||
}
|
||||
{
|
||||
$x = new template_default_arg::X_int();
|
||||
my $x = new template_default_arg::X_int();
|
||||
$x = new template_default_arg::X_int(20.0);
|
||||
$x = new template_default_arg::X_int(20.0, 200);
|
||||
}
|
||||
{
|
||||
$x = new template_default_arg::X_hello_unsigned();
|
||||
my $x = new template_default_arg::X_hello_unsigned();
|
||||
$x = new template_default_arg::X_hello_unsigned(20.0);
|
||||
$x = new template_default_arg::X_hello_unsigned(20.0, new template_default_arg::Hello_int());
|
||||
}
|
||||
{
|
||||
$y = new template_default_arg::Y_hello_unsigned();
|
||||
my $y = new template_default_arg::Y_hello_unsigned();
|
||||
$y->meth(20.0, new template_default_arg::Hello_int());
|
||||
$y->meth(new template_default_arg::Hello_int());
|
||||
$y->meth();
|
||||
}
|
||||
|
||||
{
|
||||
$fz = new template_default_arg::Foo_Z_8();
|
||||
$x = new template_default_arg::X_Foo_Z_8();
|
||||
$fzc = $x->meth($fz);
|
||||
my $fz = new template_default_arg::Foo_Z_8();
|
||||
my $x = new template_default_arg::X_Foo_Z_8();
|
||||
my $fzc = $x->meth($fz);
|
||||
}
|
||||
|
||||
# Templated functions
|
||||
{
|
||||
# plain function: int ott(Foo<int>)
|
||||
if (template_default_arg::ott(new template_default_arg::Foo_int()) != 30) {
|
||||
die "ott test 1 failed";
|
||||
}
|
||||
is(template_default_arg::ott(new template_default_arg::Foo_int()), 30, "ott test 1");
|
||||
|
||||
# %template(ott) ott<int, int>;
|
||||
if (template_default_arg::ott() != 10) {
|
||||
die "ott test 2 failed";
|
||||
}
|
||||
if (template_default_arg::ott(1) != 10) {
|
||||
die "ott test 3 failed";
|
||||
}
|
||||
if (template_default_arg::ott(1, 1) != 10) {
|
||||
die "ott test 4 failed";
|
||||
}
|
||||
is(template_default_arg::ott(), 10, "ott test 2");
|
||||
is(template_default_arg::ott(1), 10, "ott test 3");
|
||||
is(template_default_arg::ott(1, 1), 10, "ott test 4");
|
||||
|
||||
if (template_default_arg::ott("hi") != 20) {
|
||||
die "ott test 5 failed";
|
||||
}
|
||||
if (template_default_arg::ott("hi", 1) != 20) {
|
||||
die "ott test 6 failed";
|
||||
}
|
||||
if (template_default_arg::ott("hi", 1, 1) != 20) {
|
||||
die "ott test 7 failed";
|
||||
}
|
||||
is(template_default_arg::ott("hi"), 20, "ott test 5");
|
||||
is(template_default_arg::ott("hi", 1), 20, "ott test 6");
|
||||
is(template_default_arg::ott("hi", 1, 1), 20,"ott test 7");
|
||||
|
||||
# %template(ott) ott<const char *>;
|
||||
if (template_default_arg::ottstring(new template_default_arg::Hello_int(), "hi") != 40) {
|
||||
die "ott test 8 failed";
|
||||
}
|
||||
is(template_default_arg::ottstring(new template_default_arg::Hello_int(), "hi"), 40, "ott test 8");
|
||||
|
||||
if (template_default_arg::ottstring(new template_default_arg::Hello_int()) != 40) {
|
||||
die "ott test 9 failed";
|
||||
}
|
||||
is(template_default_arg::ottstring(new template_default_arg::Hello_int()), 40, "ott test 9");
|
||||
|
||||
# %template(ott) ott<int>;
|
||||
if (template_default_arg::ottint(new template_default_arg::Hello_int(), 1) != 50) {
|
||||
die "ott test 10 failed";
|
||||
}
|
||||
is(template_default_arg::ottint(new template_default_arg::Hello_int(), 1), 50, "ott test 10");
|
||||
|
||||
if (template_default_arg::ottint(new template_default_arg::Hello_int()) != 50) {
|
||||
die "ott test 11 failed";
|
||||
}
|
||||
is(template_default_arg::ottint(new template_default_arg::Hello_int()), 50, "ott test 11");
|
||||
|
||||
# %template(ott) ott<double>;
|
||||
if (template_default_arg::ott(new template_default_arg::Hello_int(), 1.0) != 60) {
|
||||
die "ott test 12 failed";
|
||||
}
|
||||
is(template_default_arg::ott(new template_default_arg::Hello_int(), 1.0), 60, "ott test 12");
|
||||
|
||||
if (template_default_arg::ott(new template_default_arg::Hello_int()) != 60) {
|
||||
die "ott test 13 failed";
|
||||
}
|
||||
is(template_default_arg::ott(new template_default_arg::Hello_int()), 60, "ott test 13");
|
||||
}
|
||||
|
||||
# Above test in namespaces
|
||||
{
|
||||
# plain function: int nsott(Foo<int>)
|
||||
if (template_default_arg::nsott(new template_default_arg::Foo_int()) != 130) {
|
||||
die "nsott test 1 failed";
|
||||
}
|
||||
is(template_default_arg::nsott(new template_default_arg::Foo_int()), 130, "nsott test 1");
|
||||
|
||||
# %template(nsott) nsott<int, int>;
|
||||
if (template_default_arg::nsott() != 110) {
|
||||
die "nsott test 2 failed";
|
||||
}
|
||||
if (template_default_arg::nsott(1) != 110) {
|
||||
die "nsott test 3 failed";
|
||||
}
|
||||
if (template_default_arg::nsott(1, 1) != 110) {
|
||||
die "nsott test 4 failed";
|
||||
}
|
||||
is(template_default_arg::nsott(), 110, "nsott test 2");
|
||||
is(template_default_arg::nsott(1), 110, "nsott test 3");
|
||||
is(template_default_arg::nsott(1, 1), 110, "nsott test 4");
|
||||
|
||||
if (template_default_arg::nsott("hi") != 120) {
|
||||
die "nsott test 5 failed";
|
||||
}
|
||||
if (template_default_arg::nsott("hi", 1) != 120) {
|
||||
die "nsott test 6 failed";
|
||||
}
|
||||
if (template_default_arg::nsott("hi", 1, 1) != 120) {
|
||||
die "nsott test 7 failed";
|
||||
}
|
||||
is(template_default_arg::nsott("hi"), 120, "nsott test 5");
|
||||
is(template_default_arg::nsott("hi", 1), 120, "nsott test 6");
|
||||
is(template_default_arg::nsott("hi", 1, 1), 120, "nsott test 7");
|
||||
|
||||
# %template(nsott) nsott<const char *>;
|
||||
if (template_default_arg::nsottstring(new template_default_arg::Hello_int(), "hi") != 140) {
|
||||
die "nsott test 8 failed";
|
||||
}
|
||||
is(template_default_arg::nsottstring(new template_default_arg::Hello_int(), "hi"), 140, "nsott test 8");
|
||||
|
||||
if (template_default_arg::nsottstring(new template_default_arg::Hello_int()) != 140) {
|
||||
die "nsott test 9 failed";
|
||||
}
|
||||
is(template_default_arg::nsottstring(new template_default_arg::Hello_int()), 140, "nsott test 9");
|
||||
|
||||
# %template(nsott) nsott<int>;
|
||||
if (template_default_arg::nsottint(new template_default_arg::Hello_int(), 1) != 150) {
|
||||
die "nsott test 10 failed";
|
||||
}
|
||||
is(template_default_arg::nsottint(new template_default_arg::Hello_int(), 1), 150, "nsott test 10");
|
||||
|
||||
if (template_default_arg::nsottint(new template_default_arg::Hello_int()) != 150) {
|
||||
die "nsott test 11 failed";
|
||||
}
|
||||
is(template_default_arg::nsottint(new template_default_arg::Hello_int()), 150, "nsott test 11");
|
||||
|
||||
# %template(nsott) nsott<double>;
|
||||
if (template_default_arg::nsott(new template_default_arg::Hello_int(), 1.0) != 160) {
|
||||
die "nsott test 12 failed";
|
||||
}
|
||||
is(template_default_arg::nsott(new template_default_arg::Hello_int(), 1.0), 160, "nsott test 12");
|
||||
|
||||
if (template_default_arg::nsott(new template_default_arg::Hello_int()) != 160) {
|
||||
die "nsott test 13 failed";
|
||||
}
|
||||
is(template_default_arg::nsott(new template_default_arg::Hello_int()), 160, "nsott test 13");
|
||||
}
|
||||
|
|
|
|||
53
Examples/test-suite/perl5/template_typedef_cplx2_runme.pl
Executable file
53
Examples/test-suite/perl5/template_typedef_cplx2_runme.pl
Executable file
|
|
@ -0,0 +1,53 @@
|
|||
#!/usr/bin/perl
|
||||
use strict;
|
||||
use warnings;
|
||||
use Test::More tests => 16;
|
||||
BEGIN { use_ok('template_typedef_cplx2') }
|
||||
require_ok('template_typedef_cplx2');
|
||||
|
||||
# adapted from ../python/template_typedef_cplx2_runme.py
|
||||
|
||||
{ # kids, don't try this at home (glob hijinks)
|
||||
my $cvar = *template_typedef_cplx2::;
|
||||
map { ${*::}{$_} = ${$cvar}{$_} } keys %{$cvar};
|
||||
}
|
||||
|
||||
#
|
||||
# double case
|
||||
#
|
||||
|
||||
my $d = eval { make_Identity_double() };
|
||||
ok(ref($d), 'is an object');
|
||||
like(ref($d), qr/ArithUnaryFunction/, "is an ArithUnaryFunction");
|
||||
|
||||
my $e = eval { make_Multiplies_double_double_double_double($d, $d) };
|
||||
ok(ref($e), 'is an object');
|
||||
like(ref($e), qr/ArithUnaryFunction/, "is an ArithUnaryFunction");
|
||||
|
||||
#
|
||||
# complex case
|
||||
#
|
||||
|
||||
my $c = eval { make_Identity_complex() };
|
||||
ok(ref($c), 'is an object');
|
||||
like(ref($c), qr/ArithUnaryFunction/, "is an ArithUnaryFunction");
|
||||
|
||||
my $f = eval { make_Multiplies_complex_complex_complex_complex($c, $c) };
|
||||
ok(ref($f), 'is an object');
|
||||
like(ref($f), qr/ArithUnaryFunction/, "is an ArithUnaryFunction");
|
||||
|
||||
#
|
||||
# Mix case
|
||||
#
|
||||
|
||||
my $g = eval { make_Multiplies_double_double_complex_complex($d, $c) };
|
||||
ok(ref($g), 'is an object');
|
||||
like(ref($g), qr/ArithUnaryFunction/, "is an ArithUnaryFunction");
|
||||
|
||||
my $h = eval { make_Multiplies_complex_complex_double_double($c, $d) };
|
||||
ok(ref($h), 'is an object');
|
||||
like(ref($h), qr/ArithUnaryFunction/, "is an ArithUnaryFunction");
|
||||
|
||||
can_ok($g, 'get_value');
|
||||
ok(eval { $g->get_value() }, 'get_value');
|
||||
|
||||
41
Examples/test-suite/perl5/template_typedef_cplx3_runme.pl
Normal file
41
Examples/test-suite/perl5/template_typedef_cplx3_runme.pl
Normal file
|
|
@ -0,0 +1,41 @@
|
|||
#!/usr/bin/perl
|
||||
use strict;
|
||||
use warnings;
|
||||
use Test::More tests => 16;
|
||||
BEGIN { use_ok('template_typedef_cplx3') }
|
||||
require_ok('template_typedef_cplx3');
|
||||
|
||||
# adapted from ../python/template_typedef_cplx3_runme.py
|
||||
|
||||
{ # kids, don't try this at home (glob hijinks)
|
||||
my $cvar = *template_typedef_cplx3::;
|
||||
map { ${*::}{$_} = ${$cvar}{$_} } keys %{$cvar};
|
||||
}
|
||||
|
||||
my $s = Sin->new();
|
||||
is($s->get_base_value(), 0);
|
||||
is($s->get_value(), 1);
|
||||
is($s->get_arith_value(), 2);
|
||||
is(my_func_r($s), 0);
|
||||
isa_ok(make_Multiplies_double_double_double_double($s,$s),
|
||||
"template_typedef_cplx3::ArithUnaryFunction_double_double");
|
||||
|
||||
my $z = CSin->new();
|
||||
is($z->get_base_value(), 0);
|
||||
is($z->get_value(), 1);
|
||||
is($z->get_arith_value(), 2);
|
||||
is(my_func_c($z), 1);
|
||||
isa_ok(make_Multiplies_complex_complex_complex_complex($z,$z),
|
||||
"template_typedef_cplx3::ArithUnaryFunction_complex_complex");
|
||||
|
||||
my $d = eval { make_Identity_double() };
|
||||
isa_ok($d, "template_typedef_cplx3::ArithUnaryFunction_double_double");
|
||||
is(my_func_r($d), 0);
|
||||
|
||||
my $c = eval { make_Identity_complex() };
|
||||
isa_ok($d, "template_typedef_cplx3::ArithUnaryFunction_double_double");
|
||||
is(my_func_c($c), 1);
|
||||
|
||||
|
||||
|
||||
|
||||
49
Examples/test-suite/perl5/template_typedef_cplx_runme.pl
Normal file
49
Examples/test-suite/perl5/template_typedef_cplx_runme.pl
Normal file
|
|
@ -0,0 +1,49 @@
|
|||
#!/usr/bin/perl
|
||||
use strict;
|
||||
use warnings;
|
||||
use Test::More tests => 14;
|
||||
BEGIN { use_ok('template_typedef_cplx') }
|
||||
require_ok('template_typedef_cplx');
|
||||
|
||||
# adapted from ../python/template_typedef_cplx_runme.py
|
||||
|
||||
{ # kids, don't try this at home (glob hijinks)
|
||||
my $cvar = *template_typedef_cplx::;
|
||||
map { ${*::}{$_} = ${$cvar}{$_} } keys %{$cvar};
|
||||
}
|
||||
|
||||
#
|
||||
# double case
|
||||
#
|
||||
|
||||
my $d = eval { make_Identity_double() };
|
||||
ok(ref($d), 'is an object');
|
||||
like(ref($d), qr/ArithUnaryFunction/, "is an ArithUnaryFunction");
|
||||
|
||||
my $e = eval { make_Multiplies_double_double_double_double($d, $d) };
|
||||
ok(ref($e), 'is an object');
|
||||
like(ref($e), qr/ArithUnaryFunction/, "is an ArithUnaryFunction");
|
||||
|
||||
#
|
||||
# complex case
|
||||
#
|
||||
|
||||
my $c = eval { make_Identity_complex() };
|
||||
ok(ref($c), 'is an object');
|
||||
like(ref($c), qr/ArithUnaryFunction/, "is an ArithUnaryFunction");
|
||||
|
||||
my $f = eval { make_Multiplies_complex_complex_complex_complex($c, $c) };
|
||||
ok(ref($f), 'is an object');
|
||||
like(ref($f), qr/ArithUnaryFunction/, "is an ArithUnaryFunction");
|
||||
|
||||
#
|
||||
# Mix case
|
||||
#
|
||||
|
||||
my $g = eval { make_Multiplies_double_double_complex_complex($d, $c) };
|
||||
ok(ref($f), 'is an object');
|
||||
like(ref($f), qr/ArithUnaryFunction/, "is an ArithUnaryFunction");
|
||||
|
||||
my $h = eval { make_Multiplies_complex_complex_double_double($c, $d) };
|
||||
ok(ref($h), 'is an object');
|
||||
like(ref($h), qr/ArithUnaryFunction/, "is an ArithUnaryFunction");
|
||||
16
Examples/test-suite/perl5/typedef_class_runme.pl
Executable file
16
Examples/test-suite/perl5/typedef_class_runme.pl
Executable file
|
|
@ -0,0 +1,16 @@
|
|||
#!/usr/bin/perl
|
||||
use strict;
|
||||
use warnings;
|
||||
use Test::More tests => 6;
|
||||
BEGIN { use_ok('typedef_class') }
|
||||
require_ok('typedef_class');
|
||||
|
||||
# adapted from ../python/typedef_class_runme.py
|
||||
|
||||
my $a = typedef_class::RealA->new();
|
||||
isa_ok($a, 'typedef_class::RealA');
|
||||
$a->{a} = 3;
|
||||
is($a->{a}, 3);
|
||||
my $b = typedef_class::B->new();
|
||||
isa_ok($b, 'typedef_class::B');
|
||||
is($b->testA($a), 3);
|
||||
9
Examples/test-suite/perl5/typemap_namespace_runme.pl
Normal file
9
Examples/test-suite/perl5/typemap_namespace_runme.pl
Normal file
|
|
@ -0,0 +1,9 @@
|
|||
#!/usr/bin/perl
|
||||
use strict;
|
||||
use warnings;
|
||||
use Test::More tests => 4;
|
||||
BEGIN { use_ok('typemap_namespace') }
|
||||
require_ok('typemap_namespace');
|
||||
|
||||
is(typemap_namespace::test1("hello"), "hello", "test 1");
|
||||
is(typemap_namespace::test2("hello"), "hello", "test 1");
|
||||
17
Examples/test-suite/perl5/typename_runme.pl
Executable file
17
Examples/test-suite/perl5/typename_runme.pl
Executable file
|
|
@ -0,0 +1,17 @@
|
|||
#!/usr/bin/perl
|
||||
use strict;
|
||||
use warnings;
|
||||
use Test::More tests => 4;
|
||||
BEGIN { use_ok('typename') }
|
||||
require_ok('typename');
|
||||
|
||||
# adapted from ../python/typename_runme.py
|
||||
|
||||
my $f = typename::Foo->new();
|
||||
my $b = typename::Bar->new();
|
||||
my $x = typename::twoFoo($f);
|
||||
is($x, 4.3656);
|
||||
my $y = typename::twoBar($b);
|
||||
is($y, 84);
|
||||
# I would like this test better if I could pass in a float to the
|
||||
# integer test and see it lose precision.
|
||||
|
|
@ -1,49 +1,42 @@
|
|||
|
||||
use strict;
|
||||
use warnings;
|
||||
use Test::More tests => 7;
|
||||
# This is the union runtime testcase. It ensures that values within a
|
||||
# union embedded within a struct can be set and read correctly.
|
||||
|
||||
use unions;
|
||||
BEGIN { use_ok('unions') }
|
||||
require_ok('unions');
|
||||
|
||||
# Create new instances of SmallStruct and BigStruct for later use
|
||||
$small = new unions::SmallStruct();
|
||||
my $small = new unions::SmallStruct();
|
||||
$small->{jill} = 200;
|
||||
|
||||
$big = new unions::BigStruct();
|
||||
my $big = new unions::BigStruct();
|
||||
$big->{smallstruct} = $small;
|
||||
$big->{jack} = 300;
|
||||
|
||||
# Use SmallStruct then BigStruct to setup EmbeddedUnionTest.
|
||||
# Ensure values in EmbeddedUnionTest are set correctly for each.
|
||||
$eut = new unions::EmbeddedUnionTest();
|
||||
my $eut = new unions::EmbeddedUnionTest();
|
||||
|
||||
# First check the SmallStruct in EmbeddedUnionTest
|
||||
$eut->{number} = 1;
|
||||
$eut->{uni}->{small} = $small;
|
||||
$Jill1 = $eut->{uni}->{small}->{jill};
|
||||
if ($Jill1 != 200) {
|
||||
die "Runtime test1 failed. eut.uni.small.jill=" , $Jill1, "\n";
|
||||
}
|
||||
my $Jill1 = $eut->{uni}->{small}->{jill};
|
||||
is($Jill1, 200, "eut.uni.small.jill");
|
||||
|
||||
$Num1 = $eut->{number};
|
||||
if ($Num1 != 1) {
|
||||
die "Runtime test2 failed. eut.number=" , $Num1, "\n";
|
||||
}
|
||||
my $Num1 = $eut->{number};
|
||||
is($Num1, 1, "test2 eut.number");
|
||||
|
||||
# Secondly check the BigStruct in EmbeddedUnionTest
|
||||
$eut->{number} = 2;
|
||||
$eut->{uni}->{big} = $big;
|
||||
$Jack1 = $eut->{uni}->{big}->{jack};
|
||||
if ($Jack1 != 300) {
|
||||
die "Runtime test3 failed. eut.uni.big.jack=" , $Jack1, "\n";
|
||||
}
|
||||
my $Jack1 = $eut->{uni}->{big}->{jack};
|
||||
is($Jack1, 300, "test3 eut.uni.big.jack");
|
||||
|
||||
$Jill2 = $eut->{uni}->{big}->{smallstruct}->{jill};
|
||||
if ($Jill2 != 200) {
|
||||
die "Runtime test4 failed. eut.uni.big.smallstruct.jill=" , $Jill2, "\n";
|
||||
}
|
||||
my $Jill2 = $eut->{uni}->{big}->{smallstruct}->{jill};
|
||||
is($Jill2, 200, "test4 eut.uni.big.smallstruct.jill");
|
||||
|
||||
$Num2 = $eut->{number};
|
||||
if ($Num2 != 2) {
|
||||
die "Runtime test5 failed. eut.number=" , $Num2, "\n";
|
||||
}
|
||||
my $Num2 = $eut->{number};
|
||||
is($Num2, 2, "test5 eut.number");
|
||||
|
||||
|
|
|
|||
10
Examples/test-suite/perl5/using1_runme.pl
Executable file
10
Examples/test-suite/perl5/using1_runme.pl
Executable file
|
|
@ -0,0 +1,10 @@
|
|||
#!/usr/bin/perl
|
||||
use strict;
|
||||
use warnings;
|
||||
use Test::More tests => 3;
|
||||
BEGIN { use_ok('using1') }
|
||||
require_ok('using1');
|
||||
|
||||
# adapted from ../python/using1_runme.py
|
||||
|
||||
is(using1::spam(37), 37);
|
||||
10
Examples/test-suite/perl5/using2_runme.pl
Executable file
10
Examples/test-suite/perl5/using2_runme.pl
Executable file
|
|
@ -0,0 +1,10 @@
|
|||
#!/usr/bin/perl
|
||||
use strict;
|
||||
use warnings;
|
||||
use Test::More tests => 3;
|
||||
BEGIN { use_ok('using2') }
|
||||
require_ok('using2');
|
||||
|
||||
# adapted from ../python/using2_runme.py
|
||||
|
||||
is(using2::spam(37), 37);
|
||||
18
Examples/test-suite/perl5/varargs_runme.pl
Normal file
18
Examples/test-suite/perl5/varargs_runme.pl
Normal file
|
|
@ -0,0 +1,18 @@
|
|||
#!/usr/bin/perl
|
||||
use strict;
|
||||
use warnings;
|
||||
use Test::More tests => 7;
|
||||
BEGIN { use_ok('varargs') }
|
||||
require_ok('varargs');
|
||||
|
||||
is(varargs::test("Hello"), "Hello");
|
||||
|
||||
my $f = new varargs::Foo("BuonGiorno", 1);
|
||||
is($f->{str}, "BuonGiorno");
|
||||
|
||||
$f = new varargs::Foo("Greetings");
|
||||
is($f->{str}, "Greetings");
|
||||
|
||||
is($f->test("Hello"), "Hello");
|
||||
|
||||
is(varargs::Foo::statictest("Grussen", 1), "Grussen");
|
||||
36
Examples/test-suite/perl5/virtual_poly_runme.pl
Normal file
36
Examples/test-suite/perl5/virtual_poly_runme.pl
Normal file
|
|
@ -0,0 +1,36 @@
|
|||
#!/usr/bin/perl
|
||||
use strict;
|
||||
use warnings;
|
||||
use Test::More tests => 8;
|
||||
BEGIN { use_ok('virtual_poly') }
|
||||
require_ok('virtual_poly');
|
||||
|
||||
my $d = virtual_poly::NDouble->new(3.5);
|
||||
my $i = virtual_poly::NInt->new(2);
|
||||
|
||||
#
|
||||
# the copy methods return the right polymorphic types
|
||||
#
|
||||
my $dc = $d->copy();
|
||||
my $ic = $i->copy();
|
||||
|
||||
is($d->get(), $dc->get());
|
||||
|
||||
is($i->get(), $ic->get());
|
||||
|
||||
virtual_poly::incr($ic);
|
||||
|
||||
is($i->get() + 1, $ic->get());
|
||||
|
||||
my $dr = $d->ref_this();
|
||||
is($d->get(), $dr->get());
|
||||
|
||||
|
||||
#
|
||||
# 'narrowing' also works
|
||||
#
|
||||
my $ddc = virtual_poly::NDouble::narrow($d->nnumber());
|
||||
is($d->get, $ddc->get());
|
||||
|
||||
my $dic = virtual_poly::NInt::narrow($i->nnumber());
|
||||
is($i->get(), $dic->get());
|
||||
|
|
@ -1,9 +1,20 @@
|
|||
use voidtest;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Test::More tests => 7;
|
||||
BEGIN { use_ok('voidtest') }
|
||||
require_ok('voidtest');
|
||||
|
||||
if (1) {
|
||||
$f = new voidtest::Foo();
|
||||
$v1 = voidtest::vfunc1($f);
|
||||
$v2 = voidtest::vfunc2($f);
|
||||
$v3 = voidtest::vfunc3($v1);
|
||||
$v4 = voidtest::vfunc4($f);
|
||||
# adapted from ../python/voidtest_runme.py
|
||||
voidtest::globalfunc();
|
||||
my $f = voidtest::Foo->new();
|
||||
is($f->memberfunc(), undef);
|
||||
{ local $TODO = "opaque pointers hidden behind layer of indirection";
|
||||
my $v1 = voidtest::vfunc1($f);
|
||||
my $v2 = voidtest::vfunc2($f);
|
||||
is($v1, $v2);
|
||||
my $v3 = voidtest::vfunc3($v1);
|
||||
is($v3->this, $f->this);
|
||||
my $v4 = voidtest::vfunc4($f);
|
||||
is($v1, $v4);
|
||||
}
|
||||
ok(1, "done");
|
||||
|
|
|
|||
14
Examples/test-suite/perl5/wrapmacro_runme.pl
Executable file
14
Examples/test-suite/perl5/wrapmacro_runme.pl
Executable file
|
|
@ -0,0 +1,14 @@
|
|||
#!/usr/bin/perl
|
||||
use strict;
|
||||
use warnings;
|
||||
use Test::More tests => 5;
|
||||
BEGIN { use_ok('wrapmacro') }
|
||||
require_ok('wrapmacro');
|
||||
|
||||
# adapted from ../python/wrapmacro_runme.py
|
||||
|
||||
my $a = 2;
|
||||
my $b = -1;
|
||||
is(wrapmacro::max($a,$b), 2);
|
||||
is(wrapmacro::max($a/7.0, -$b*256), 256);
|
||||
is(wrapmacro::GUINT16_SWAP_LE_BE_CONSTANT(1), 256);
|
||||
Loading…
Add table
Add a link
Reference in a new issue