jyapayne/swig
Watch
1
0
Fork
You've already forked swig
 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

several testcases for perl

Browse source 
git-svn-id: https://swig.svn.sourceforge.net/svnroot/swig/trunk@10403 626c5289-ae23-0410-ae9c-e8d60b6d4f22
This commit is contained in:
Robert Stone 2008-04-30 21:02:46 +00:00
commit 8b713d759d
53 changed files with 2043 additions and 492 deletions
Download patch file Download diff file Expand all files Collapse all files

15
Examples/test-suite/perl5/README
View file

@ -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
View 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
View 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);

15
Examples/test-suite/perl5/apply_strings_runme.pl
View file

@ -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
View 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");
}

14
Examples/test-suite/perl5/char_strings_runme.pl
View file

@ -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
View 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
View 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");
}

210
Examples/test-suite/perl5/default_args_runme.pl
View file

@ -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
View 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
View 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
View 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);

387
Examples/test-suite/perl5/enum_thorough_runme.pl
View file

@ -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
View 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");

11
Examples/test-suite/perl5/global_vars_runme.pl
View file

@ -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
View 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
View 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');

12
Examples/test-suite/perl5/import_nomodule_runme.pl
View file

@ -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
View 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
View 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);

Some files were not shown because too many files have changed in this diff Show more