[libinline-java-perl] 326/398: 0_48_94

Jonas Smedegaard dr at jones.dk
Thu Feb 26 11:43:19 UTC 2015


This is an automated email from the git hooks/post-receive script.

js pushed a commit to tag 0.55
in repository libinline-java-perl.

commit ed2d990513daa3f07e5c73dfac024a650e9f661b
Author: patrick_leb <>
Date:   Tue Jun 8 00:58:12 2004 +0000

    0_48_94
---
 Java/Callback.pm                                   |  6 +++
 Java/PerlInterpreter/Makefile.PL                   |  3 +-
 Java/PerlInterpreter/PerlInterpreter.xs            | 18 +++++++-
 Java/Portable.pm                                   |  1 +
 .../org/perl/inline/java/InlineJavaPerlObject.java | 10 ++---
 t/12_2_perl_objects.t                              | 51 ++++++++++++++--------
 6 files changed, 63 insertions(+), 26 deletions(-)

diff --git a/Java/Callback.pm b/Java/Callback.pm
index bef6980..55cb811 100644
--- a/Java/Callback.pm
+++ b/Java/Callback.pm
@@ -145,6 +145,12 @@ sub ObjectCount {
 }
 
 
+sub __GetObjects {
+	return \%OBJECTS ;
+}
+
+
+
 ########## Utility methods used by Java to access Perl objects #################
 
 
diff --git a/Java/PerlInterpreter/Makefile.PL b/Java/PerlInterpreter/Makefile.PL
index 35bcb2c..30ec5ef 100644
--- a/Java/PerlInterpreter/Makefile.PL
+++ b/Java/PerlInterpreter/Makefile.PL
@@ -13,11 +13,12 @@ chomp($ldopts) ;
 
 my $pre = Inline::Java::Portable::portable("PRE_WHOLE_ARCHIVE") ;
 my $post = Inline::Java::Portable::portable("POST_WHOLE_ARCHIVE") ;
+my $dupenv = Inline::Java::Portable::portable("PERL_PARSE_DUP_ENV") ;
 
 WriteMakefile(
 	NAME => 'Inline::Java::PerlInterpreter',
 	VERSION_FROM => 'PerlInterpreter.pm',
-	CCFLAGS => $ccopts,
+	CCFLAGS => "$ccopts $dupenv",
 	LDDLFLAGS => "$pre $ldopts $post $Config{lddlflags}",
 	INC => join(' ', @main::I),
 	# CCFLAGS => '-D_REENTRANT',
diff --git a/Java/PerlInterpreter/PerlInterpreter.xs b/Java/PerlInterpreter/PerlInterpreter.xs
index 7befb7d..3a6ac1c 100644
--- a/Java/PerlInterpreter/PerlInterpreter.xs
+++ b/Java/PerlInterpreter/PerlInterpreter.xs
@@ -37,10 +37,24 @@ void throw_ijp(JNIEnv *env, char *msg){
 
 JNIEXPORT void JNICALL Java_org_perl_inline_java_InlineJavaPerlInterpreter_construct(JNIEnv *env, jclass cls){
 	char *args[] = {"inline-java", "-e1"} ;
-
+	int envl = 0 ;
+	int i = 0 ;
+	char **envdup = NULL ;
+
+#ifdef PERL_PARSE_ENV_DUP
+	/* This will leak, but it's a one shot... */
+	for (i = 0 ; environ[i] != NULL ; i++){
+		envl++ ;
+	}
+	envdup = (char **)calloc(envl + 1, sizeof(char *)) ;
+	for (i = 0 ; i < envl ; i++){
+		envdup[i] = strdup(environ[i]) ;
+	}
+#endif
+	
 	interp = perl_alloc() ;
 	perl_construct(interp) ;
-	perl_parse(interp, xs_init, 2, args, NULL) ;
+	perl_parse(interp, xs_init, 2, args, envdup) ;
 	perl_run(interp) ;
 }
 
diff --git a/Java/Portable.pm b/Java/Portable.pm
index e7a4923..6b294a2 100644
--- a/Java/Portable.pm
+++ b/Java/Portable.pm
@@ -159,6 +159,7 @@ sub portable {
 		JVM_SO				=>	"libjvm.$Config{dlext}",
 		PRE_WHOLE_ARCHIVE	=>  '-Wl,--whole-archive',
 		POST_WHOLE_ARCHIVE	=>  '-Wl,--no-whole-archive',
+		PERL_PARSE_DUP_ENV	=>  '-DPERL_PARSE_DUP_ENV',
 	} ;
 
 	my $map = {
diff --git a/Java/sources/org/perl/inline/java/InlineJavaPerlObject.java b/Java/sources/org/perl/inline/java/InlineJavaPerlObject.java
index b234d93..b57caab 100644
--- a/Java/sources/org/perl/inline/java/InlineJavaPerlObject.java
+++ b/Java/sources/org/perl/inline/java/InlineJavaPerlObject.java
@@ -30,7 +30,7 @@ public class InlineJavaPerlObject extends InlineJavaPerlCaller {
 	}
 
 
-	public int GetId(){
+	int GetId(){
 		return id ;
 	}
 
@@ -50,12 +50,12 @@ public class InlineJavaPerlObject extends InlineJavaPerlCaller {
 	}
 
 
-	public void Done() throws InlineJavaPerlException, InlineJavaException {
-		Done(false) ;
+	public void Dispose() throws InlineJavaPerlException, InlineJavaException {
+		Dispose(false) ;
 	}
 
 
-	protected void Done(boolean gc) throws InlineJavaPerlException, InlineJavaException {
+	protected void Dispose(boolean gc) throws InlineJavaPerlException, InlineJavaException {
 		if (id != 0){
 			CallPerlSub("Inline::Java::Callback::java_finalize", new Object [] {new Integer(id), new Boolean(gc)}) ;
 		}
@@ -64,7 +64,7 @@ public class InlineJavaPerlObject extends InlineJavaPerlCaller {
 
 	protected void finalize() throws Throwable {
 		try {
-			Done(true) ;
+			Dispose(true) ;
 		}
 		finally {
 			super.finalize() ;
diff --git a/t/12_2_perl_objects.t b/t/12_2_perl_objects.t
index 6f5a0a7..ba5a989 100755
--- a/t/12_2_perl_objects.t
+++ b/t/12_2_perl_objects.t
@@ -13,7 +13,7 @@ use Data::Dumper ;
 
 
 BEGIN {
-	my $cnt = 14 ;
+	my $cnt = 21 ;
 	plan(tests => $cnt) ;
 }
 
@@ -25,24 +25,34 @@ my $t = new t16() ;
 		$t->set($o) ;
 		ok($t->get(), $o) ;
 		ok($t->get()->{name}, 'toto') ;
+		check_count(1) ; # po
+
 		ok($t->round_trip($o), $o) ;
-		ok($o->get("name"), 'toto') ;
+		check_count(2) ; # po + 1 leaked object
+
 		ok($t->method_call($o, 'get', ['name']), 'toto') ;
+		check_count(2) ; # po + 1 leaked object
+
+		ok($t->add_eval(5, 6), 11) ;
+		check_count(2) ; # po + 1 leaked object
+
 		eval {$t->method_call($o, 'bad', ['bad'])} ; ok($@, qr/Can't locate object method "bad" via package "Obj"/) ;
+		check_count(3) ; # po + $o + 1 leaked object
 		eval {$t->round_trip({})} ; ok($@, qr/^Can't convert (.*?) to object org.perl.inline.java.InlineJavaPerlObject/) ;
-		ok($t->add_eval(5, 6), 11) ;
 		eval {$t->error()} ; ok($@, qr/alone/) ;
 
-		my $cnt = Inline::Java::Callback::ObjectCount() ;
-		$t->clean($o) ;
-		ok($cnt, Inline::Java::Callback::ObjectCount()) ;
+		check_count(3) ; # po + 2 leaked objects
+		$t->dispose($o) ;
+		check_count(2) ; # 2 leaked objects
 
 		my $jo = $t->create("Obj", ['name', 'titi']) ;
 		ok($jo->get("name"), 'titi') ;
 		$t->have_fun() ;
 		ok($jo->get('shirt'), qr/lousy t-shirt/) ;
+		check_count(3) ; # po + 2 leaked objects
 
-		$t->clean(undef) ;
+		$t->dispose(undef) ;
+		check_count(2) ; # 2 leaked objects
 	} ;
 	if ($@){
 		if (caught("java.lang.Throwable")){
@@ -56,7 +66,17 @@ my $t = new t16() ;
 }
 
 ok($t->__get_private()->{proto}->ObjectCount(), 1) ;
-ok(Inline::Java::Callback::ObjectCount(), 3) ;
+check_count(2) ; # 2 leaked objects
+
+
+sub check_count {
+	ok($_[0], Inline::Java::Callback::ObjectCount()) ;
+}
+
+
+sub debug_objects {
+	map {print "$_\n"} %{Inline::Java::Callback::__GetObjects()} ;
+}
 
 
 package Obj ;
@@ -114,7 +134,7 @@ class t16 {
 
 	public String method_call(InlineJavaPerlObject o, String name, Object args[]) throws InlineJavaException, InlineJavaPerlException {
 		String s = (String)o.InvokeMethod(name, args) ;
-		o.Done() ;
+		o.Dispose() ;
 		return s ;
 	}
 
@@ -126,12 +146,12 @@ class t16 {
 		return o ;
 	}
 
-	public void clean(InlineJavaPerlObject o) throws InlineJavaException, InlineJavaPerlException {
+	public void dispose(InlineJavaPerlObject o) throws InlineJavaException, InlineJavaPerlException {
 		if (o != null){
-			o.Done() ;
+			o.Dispose() ;
 		}
-		else if (po != null){
-			po.Done() ;
+		if (po != null){
+			po.Dispose() ;
 		}
 	}
 
@@ -143,9 +163,4 @@ class t16 {
 	public void have_fun() throws InlineJavaException, InlineJavaPerlException {
 		po.InvokeMethod("set", new Object [] {"shirt", "I've been to Java and all I got was this lousy t-shirt!"}) ;
 	}
-
-	public void gc(){
-		System.runFinalization() ;
-		System.gc() ;
-	}
 }

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libinline-java-perl.git



More information about the Pkg-perl-cvs-commits mailing list