9 files changed, 279 insertions, 0 deletions
diff --git a/Examples/test-suite/perl5/.cvsignore b/Examples/test-suite/perl5/.cvsignore
new file mode 100644
index 000000000..e32f11c0b
--- /dev/null
+++ b/Examples/test-suite/perl5/.cvsignore
@@ -0,0 +1,4 @@
+*wrap*
+*.pm
+*.so
+*.dll
diff --git a/Examples/test-suite/perl5/Makefile b/Examples/test-suite/perl5/Makefile
new file mode 100644
index 000000000..d8ee34446
--- /dev/null
+++ b/Examples/test-suite/perl5/Makefile
@@ -0,0 +1,42 @@
+#######################################################################
+# $Header$
+# Makefile for perl5 test-suite
+#######################################################################
+
+LANGUAGE   = perl5
+SCRIPTSUFFIX = _runme.pl
+
+include ../common.mk
+
+# Overridden variables here
+SWIGOPT    = -shadow -I$(TOP)/$(TEST_SUITE)
+
+# Rules for the different types of tests
+%.cpptest: 
+	$(setup) \
+	($(swig_and_compile_cpp); ); \
+	$(run_testcase)
+
+%.ctest:
+	$(setup) \
+	($(swig_and_compile_c); ); \
+	$(run_testcase)
+
+%.multicpptest: 
+	$(setup) \
+	($(swig_and_compile_multi_cpp); ); \
+	$(run_testcase)
+
+# Runs the testcase. A testcase is only run if
+# a file is found which has _runme.pl appended after the testcase name.
+run_testcase = \
+	if [ -f $*\_runme.pl ]; then ( \
+	  env LD_LIBRARY_PATH=$(DYNAMIC_LIB_PATH):$$LD_LIBRARY_PATH perl $*\_runme.pl;) \
+	fi;
+
+# Clean: remove the generated .pm file
+%.clean:
+	@rm -f $*.pm;
+
+clean:
+	$(MAKE) -f $(TOP)/Makefile perl5_clean
diff --git a/Examples/test-suite/perl5/README b/Examples/test-suite/perl5/README
new file mode 100644
index 000000000..649cca90a
--- /dev/null
+++ b/Examples/test-suite/perl5/README
@@ -0,0 +1,4 @@
+See ../README for common README file.
+
+Any testcases which have _runme.pl appended after the testcase name will be detected and run.
+
diff --git a/Examples/test-suite/perl5/import_nomodule_runme.pl b/Examples/test-suite/perl5/import_nomodule_runme.pl
new file mode 100644
index 000000000..965d10582
--- /dev/null
+++ b/Examples/test-suite/perl5/import_nomodule_runme.pl
@@ -0,0 +1,7 @@
+use import_nomodule;
+
+$f = import_nomodule::create_Foo();
+import_nomodule::test1($f,42);
+
+$b = new import_nomodule::Bar();
+import_nomodule::test1($b,37);
diff --git a/Examples/test-suite/perl5/imports_runme.pl b/Examples/test-suite/perl5/imports_runme.pl
new file mode 100644
index 000000000..fd730fedf
--- /dev/null
+++ b/Examples/test-suite/perl5/imports_runme.pl
@@ -0,0 +1,5 @@
+use imports_b;
+use imports_a;
+
+$x = imports_bc::new_B();
+imports_ac::A_hello($x);
diff --git a/Examples/test-suite/perl5/overload_copy_runme.pl b/Examples/test-suite/perl5/overload_copy_runme.pl
new file mode 100644
index 000000000..06d03f5e6
--- /dev/null
+++ b/Examples/test-suite/perl5/overload_copy_runme.pl
@@ -0,0 +1,5 @@
+
+use overload_copy;
+
+$f = new overload_copy::Foo();
+$g = new overload_copy::Foo($f);
diff --git a/Examples/test-suite/perl5/overload_simple_runme.pl b/Examples/test-suite/perl5/overload_simple_runme.pl
new file mode 100644
index 000000000..5e348fba1
--- /dev/null
+++ b/Examples/test-suite/perl5/overload_simple_runme.pl
@@ -0,0 +1,120 @@
+use overload_simple;
+
+$f = new overload_simple::Foo();
+$b = new overload_simple::Bar();
+$v = overload_simple::malloc_void(32);
+
+if (overload_simple::foo(3) != "foo:int") {
+    die("foo(int)");
+}
+
+if (overload_simple::foo(3.0) != "foo:double") {
+    die("foo(double)");
+}
+
+if (overload_simple::foo("hello") != "foo:char *") {
+    die("foo(char *)");
+}
+
+if (overload_simple::foo($f) != "foo:Foo *") {
+    die("foo(Foo *)");
+}
+
+if (overload_simple::foo($b) != "foo:Bar *") {
+    die("foo(Bar *)");
+}
+
+if (overload_simple::foo($v) != "foo:void *") {
+    die("foo(void *)");
+}
+
+$s = new overload_simple::Spam();
+
+if ($s->foo(3) != "foo:int") {
+    die("Spam::foo(int)");
+}
+
+if ($s->foo(3.0) != "foo:double") {
+    die("Spam::foo(double)");
+}
+
+if ($s->foo("hello") != "foo:char *") {
+    die("Spam::foo(char *)");
+}
+
+if ($s->foo($f) != "foo:Foo *") {
+    die("Spam::foo(Foo *)");
+}
+
+if ($s->foo($b) != "foo:Bar *") {
+    die("Spam::foo(Bar *)");
+}
+
+if ($s->foo($v) != "foo:void *") {
+    die("Spam::foo(void *)");
+}
+
+if (overload_simple::Spam::bar(3) != "bar:int") {
+    die("Spam::bar(int)");
+}
+
+if (overload_simple::Spam::bar(3.0) != "bar:double") {
+    die("Spam::bar(double)");
+}
+
+if (overload_simple::Spam::bar("hello") != "bar:char *") {
+    die("Spam::bar(char *)");
+}
+
+if (overload_simple::Spam::bar($f) != "bar:Foo *") {
+    die("Spam::bar(Foo *)");
+}
+
+if (overload_simple::Spam::bar($b) != "bar:Bar *") {
+    die("Spam::bar(Bar *)");
+}
+
+if (overload_simple::Spam::bar($v) != "bar:void *") {
+    die("Spam::bar(void *)");
+}
+
+# Test constructors
+
+$s = new overload_simple::Spam();
+if ($s->{type} != "none") {
+    die("Spam()");
+}
+
+$s = new overload_simple::Spam(3);
+if ($s->{type} != "int") {
+    die("Spam(int)");
+}
+
+$s = new overload_simple::Spam(3.0);
+if ($s->{type} != "double") {
+    die("Spam(double)");
+}
+
+$s = new overload_simple::Spam("hello");
+if ($s->{type} != "char *") {
+    die("Spam(char *)");
+}
+
+$s = new overload_simple::Spam($f);
+if ($s->{type} != "Foo *") {
+    die("Spam(Foo *)");
+}
+
+$s = new overload_simple::Spam($b);
+if ($s->{type} != "Bar *") {
+    die("Spam(Bar *)");
+}
+
+$s = new overload_simple::Spam($v);
+if ($s->{type} != "void *") {
+    die("Spam(void *)");
+}
+
+
+
+
diff --git a/Examples/test-suite/perl5/primitive_ref_runme.pl b/Examples/test-suite/perl5/primitive_ref_runme.pl
new file mode 100644
index 000000000..727b3ec6e
--- /dev/null
+++ b/Examples/test-suite/perl5/primitive_ref_runme.pl
@@ -0,0 +1,38 @@
+use primitive_ref;
+
+if (primitive_ref::ref_int(3) != 3) {
+    print "ref_int failed!\n";
+}
+if (primitive_ref::ref_uint(3) != 3) {
+    print "ref_uint failed!\n";
+}
+if (primitive_ref::ref_short(3) != 3) {
+    print "ref_short failed!\n";
+}
+if (primitive_ref::ref_ushort(3) != 3) {
+    print "ref_ushort failed!\n";
+}
+if (primitive_ref::ref_long(3) != 3) {
+    print "ref_long failed!\n";
+}
+if (primitive_ref::ref_ulong(3) != 3) {
+    print "ref_ulong failed!\n";
+}
+if (primitive_ref::ref_schar(3) != 3) {
+    print "ref_schar failed!\n";
+}
+if (primitive_ref::ref_uchar(3) != 3) {
+    print "ref_uchar failed!\n";
+}
+if (primitive_ref::ref_bool(1) != 1) {
+    print "ref_bool failed!\n";
+}
+if (primitive_ref::ref_float(3.5) != 3.5) {
+    print "ref_float failed!\n";
+}
+if (primitive_ref::ref_double(3.5) != 3.5) {
+    print "ref_double failed!\n";
+}
+if (primitive_ref::ref_char('x') != 'x') {
+    print "ref_char failed!\n";
+}
diff --git a/Examples/test-suite/perl5/unions_runme.pl b/Examples/test-suite/perl5/unions_runme.pl
new file mode 100644
index 000000000..fca499f0e
--- /dev/null
+++ b/Examples/test-suite/perl5/unions_runme.pl
@@ -0,0 +1,54 @@
+
+# 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;
+
+# Create new instances of SmallStruct and BigStruct for later use
+$small = new unions::SmallStruct();
+$small->{jill} = 200;
+
+$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();
+
+# First check the SmallStruct in EmbeddedUnionTest
+$eut->{number} = 1;
+$eut->{uni}->{small} = $small;
+$Jill1 = $eut->{uni}->{small}->{jill};
+if ($Jill1 != 200) {
+    print "Runtime test1 failed. eut.uni.small.jill=" , $Jill1, "\n";
+    exit 1;
+}
+
+$Num1 = $eut->{number};
+if ($Num1 != 1) {
+    print "Runtime test2 failed. eut.number=" , $Num1, "\n";
+    exit 1;
+}
+
+# Secondly check the BigStruct in EmbeddedUnionTest
+$eut->{number} = 2;
+$eut->{uni}->{big} = $big;
+$Jack1 = $eut->{uni}->{big}->{jack};
+if ($Jack1 != 300) {
+    print "Runtime test3 failed. eut.uni.big.jack=" , $Jack1, "\n";
+    exit 1;
+}
+
+$Jill2 = $eut->{uni}->{big}->{smallstruct}->{jill};
+if ($Jill2 != 200) {
+    print "Runtime test4 failed. eut.uni.big.smallstruct.jill=" , $Jill2, "\n";
+    exit 1;
+}
+
+$Num2 = $eut->{number};
+if ($Num2 != 2) {
+    print "Runtime test5 failed. eut.number=" , $Num2, "\n";
+    exit 1;
+}
+