[libinline-java-perl] 250/398: en route toward 0.44 RC2
Jonas Smedegaard
dr at jones.dk
Thu Feb 26 11:43:10 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 c1b9a526fc16952134d3a00502b35aeb38f3b7c7
Author: patrick_leb <>
Date: Sun Nov 23 20:22:58 2003 +0000
en route toward 0.44 RC2
---
Java.pm | 140 +++++++++++++++++----------------
Java/JNI.xs | 30 ++++++-
Java/Protocol.pm | 3 +-
Java/sources/InlineJavaPerlCaller.java | 85 ++++++--------------
README | 5 ++
TODO | 3 +
t/12_callbacks.t | 90 ++++++++++++++++++++-
7 files changed, 225 insertions(+), 131 deletions(-)
diff --git a/Java.pm b/Java.pm
index 1cd8aab..10bc8f5 100644
--- a/Java.pm
+++ b/Java.pm
@@ -437,29 +437,49 @@ sub load {
$o->set_java_config('id', scalar(@INLINES) - 1) ;
Inline::Java::debug(3, "Inline::Java object id is " . $o->get_java_config('id')) ;
- my $classes = [] ;
+ $o->study_module() ;
if ((defined($o->get_java_config('STUDY')))&&(scalar($o->get_java_config('STUDY')))){
- $classes = $o->get_java_config('STUDY') ;
+ $o->_study($o->get_java_config('STUDY')) ;
}
- $o->_study($classes, 1) ;
$o->set_java_config('loaded', 1) ;
Inline::Java::debug(1, "load done.") ;
}
-# This function 'studies' the specified classes and binds them to
-# Perl
-sub _study {
+# This function 'studies' the classes generated by the inlined code.
+sub study_module {
my $o = shift ;
- my $classes = shift ;
- my $study_module = shift ;
- my $install_dir = File::Spec->catdir($o->get_api('install_lib'),
+ my $install_dir = File::Spec->catdir($o->get_api('install_lib'),
'auto', $o->get_api('modpname')) ;
+ my $cache = $o->get_api('modfname') . '.' . $o->get_api('suffix') ;
+
+ my $lines = [] ;
+ if (! $o->get_java_config('built')){
+ # Since we didn't build the module, this means that
+ # it was up to date. We can therefore use the data
+ # from the cache.
+ Inline::Java::debug(1, "using jdat cache") ;
+ my $p = File::Spec->catfile($install_dir, $cache) ;
+ my $size = (-s $p) || 0 ;
+ if ($size > 0){
+ if (open(Inline::Java::CACHE, "<$p")){
+ while (<Inline::Java::CACHE>){
+ push @{$lines}, $_ ;
+ }
+ close(Inline::Java::CACHE) ;
+ }
+ else{
+ croak "Can't open $p for reading: $!" ;
+ }
+ }
+ }
+ else{
+ # First thing to do is get the list of classes that comprise the module.
- if ($study_module){
- # We need to add the classes that are in the directory or under...
+ # We need the classes that are in the directory or under...
+ my @classes = () ;
my $cwd = Cwd::cwd() ;
if ($o->get_config('UNTAINT')){
($cwd) = $cwd =~ /(.*)/ ;
@@ -471,10 +491,37 @@ sub _study {
my @fl = Inline::Java::Portable::find_classes_in_dir('.') ;
chdir $cwd ;
foreach my $f (@fl){
- push @{$classes}, $f->{class} ;
+ push @classes, $f->{class} ;
+ }
+
+ # Now we ask Java the info about those classes...
+ $lines = $o->report(@classes) ;
+
+ # and we update the cache with these results.
+ Inline::Java::debug(1, "updating jdat cache") ;
+ my $p = File::Spec->catfile($install_dir, $cache) ;
+ if (open(Inline::Java::CACHE, ">$p")){
+ foreach my $l (@{$lines}){
+ print Inline::Java::CACHE "$l\n" ;
+ }
+ close(Inline::Java::CACHE) ;
+ }
+ else{
+ croak "Can't open $p file for writing" ;
}
}
+ # Now we read up the symbols and bind them to Perl.
+ $o->bind_jdat($o->load_jdat($lines)) ;
+}
+
+
+# This function 'studies' the specified classes and binds them to
+# Perl.
+sub _study {
+ my $o = shift ;
+ my $classes = shift ;
+
my @new_classes = () ;
foreach my $class (@{$classes}){
$class = Inline::Java::Class::ValidateClass($class) ;
@@ -482,78 +529,37 @@ sub _study {
push @new_classes, $class ;
}
}
-
if (! scalar(@new_classes)){
return ;
}
- # Then we ask it to give us the public symbols from the classes
- # that we got.
- my @lines = $o->report(\@new_classes, $study_module) ;
-
+ my $lines = $o->report(@new_classes) ;
# Now we read up the symbols and bind them to Perl.
- $o->bind_jdat($o->load_jdat(@lines)) ;
+ $o->bind_jdat($o->load_jdat($lines)) ;
}
-# This function asks the JVM what are the public symbols for the specified
-# classes
sub report {
my $o = shift ;
- my $classes = shift ;
- my $study_module = shift || 0 ;
-
- my $install_dir = File::Spec->catdir($o->get_api('install_lib'),
- 'auto', $o->get_api('modpname')) ;
- my $cache = $o->get_api('modfname') . '.' . $o->get_api('suffix') ;
+ my @classes = @_ ;
- if (($study_module)&&(! $o->get_java_config('built'))){
- # Since we didn't build the module, this means that
- # it was up to date. We can therefore use the data
- # from the cache
- Inline::Java::debug(1, "using jdat cache") ;
- my $p = File::Spec->catfile($install_dir, $cache) ;
- my $size = (-s $p) || 0 ;
- if ($size > 0){
- if (open(Inline::Java::CACHE, "<$p")){
- my $resp = join("", <Inline::Java::CACHE>) ;
- close(Inline::Java::CACHE) ;
- return split("\n", $resp) ;
- }
- else{
- croak "Can't open $p for reading: $!" ;
- }
- }
- }
-
- # Ok, there are some classes in there that we don't know about.
- # Ask for the info on the classes
- my $pc = new Inline::Java::Protocol(undef, $o) ;
- my $resp = $pc->Report(join(" ", @{$classes})) ;
-
- if (($study_module)&&($o->get_java_config('built'))){
- # Update the cache.
- Inline::Java::debug(1, "updating jdat cache") ;
- my $p = File::Spec->catfile($install_dir, $cache) ;
- if (open(Inline::Java::CACHE, ">$p")){
- print Inline::Java::CACHE $resp ;
- close(Inline::Java::CACHE) ;
- }
- else{
- croak "Can't open $p file for writing" ;
- }
+ my @lines = () ;
+ if (scalar(@classes)){
+ my $pc = new Inline::Java::Protocol(undef, $o) ;
+ my $resp = $pc->Report(join(" ", @classes)) ;
+ @lines = split("\n", $resp) ;
}
- return split("\n", $resp) ;
+ return \@lines ;
}
# Load the jdat code information file.
sub load_jdat {
my $o = shift ;
- my @lines = @_ ;
+ my $lines = shift ;
- Inline::Java::debug(5, join("\n", @lines)) ;
+ Inline::Java::debug_obj($lines) ;
# We need an array here since the same object can have many
# study sessions.
@@ -568,7 +574,7 @@ sub load_jdat {
my $idx = 0 ;
my $current_class = undef ;
- foreach my $line (@lines){
+ foreach my $line (@{$lines}){
chomp($line) ;
if ($line =~ /^class ($re)$/){
# We found a class definition
@@ -724,7 +730,7 @@ CODE
$code .= $o->bind_method($idx, $class, $method) ;
}
- Inline::Java::debug(5, $code) ;
+ Inline::Java::debug_obj(\$code) ;
# open (Inline::Java::CODE, ">>code") and print CODE $code and close(CODE) ;
@@ -1020,7 +1026,7 @@ sub study_classes {
}
if (defined($o)){
- $o->_study($classes, 0) ;
+ $o->_study($classes) ;
}
else {
my $msg = "Can't place studied classes under package '$package' since Inline::Java was not used there. Valid packages are:\n" ;
diff --git a/Java/JNI.xs b/Java/JNI.xs
index 4edb3bd..2798faa 100644
--- a/Java/JNI.xs
+++ b/Java/JNI.xs
@@ -77,7 +77,7 @@ jstring JNICALL jni_callback(JNIEnv *env, jobject obj, jstring cmd){
/* Check the eval */
if (SvTRUE(ERRSV)){
STRLEN n_a ;
- fprintf(stderr, "%s", SvPV(ERRSV, n_a)) ;
+ fprintf(stderr, "Exception caught in JNI callback: %s", SvPV(ERRSV, n_a)) ;
exit(-1) ;
}
else{
@@ -109,6 +109,31 @@ jstring JNICALL jni_callback(JNIEnv *env, jobject obj, jstring cmd){
}
+/* This function loads up a Perl Interpreter */
+static PerlInterpreter *my_perl ;
+JNIEXPORT void JNICALL Java_org_perl_inline_java_InlineJavaPerlInterpreter_jni_1load_1perl_1interpreter(JNIEnv *env, jobject obj){
+ JNINativeMethod nm ;
+ jclass ijs_class ;
+ char *embedding[] = { "", "-e", "0" } ;
+
+ /* Register the callback function */
+ ijs_class = (*(env))->FindClass(env, "org/perl/inline/java/InlineJavaServer") ;
+ check_exception(env, "Can't find class InlineJavaServer") ;
+
+ nm.name = "jni_callback" ;
+ nm.signature = "(Ljava/lang/String;)Ljava/lang/String;" ;
+ nm.fnPtr = jni_callback ;
+ (*(env))->RegisterNatives(env, ijs_class, &nm, 1) ;
+ check_exception(env, "Can't register method jni_callback in class InlineJavaServer") ;
+
+ my_perl = perl_alloc() ;
+ perl_construct(my_perl) ;
+
+ perl_parse(my_perl, NULL, 3, embedding, NULL) ;
+ perl_run(my_perl) ;
+}
+
+
MODULE = Inline::Java::JNI PACKAGE = Inline::Java::JNI
@@ -259,6 +284,9 @@ process_command(this, data)
check_exception(env, "Can't create java.lang.String") ;
resp = (*(env))->CallObjectMethod(env, this->ijs, this->process_command_mid, cmd) ;
+ /* Thanks Dave Blob for spotting this. This is necessary since this codes never really returns to Java
+ It simply calls into Java and comes back. */
+ (*(env))->DeleteLocalRef(env, cmd);
check_exception(env, "Can't call ProcessCommand in InlineJavaServer") ;
hook = perl_get_sv("Inline::Java::Callback::OBJECT_HOOK", FALSE) ;
diff --git a/Java/Protocol.pm b/Java/Protocol.pm
index 21608fb..8f92928 100644
--- a/Java/Protocol.pm
+++ b/Java/Protocol.pm
@@ -57,6 +57,7 @@ sub ServerType {
}
+# Known issue: $classes must contain at least one class name.
sub Report {
my $this = shift ;
my $classes = shift ;
@@ -361,7 +362,7 @@ sub DeserializeObject {
if (Inline::Java::Class::ClassIsReference($elem_class)){
if (! Inline::Java::known_to_perl($pkg, $elem_class)){
if (($thrown)||($this->{inline}->get_java_config('AUTOSTUDY'))){
- $this->{inline}->_study([$elem_class], 0) ;
+ $this->{inline}->_study([$elem_class]) ;
}
else{
# Object is not known to Perl, it lives as a
diff --git a/Java/sources/InlineJavaPerlCaller.java b/Java/sources/InlineJavaPerlCaller.java
index 728a2a1..67a802f 100644
--- a/Java/sources/InlineJavaPerlCaller.java
+++ b/Java/sources/InlineJavaPerlCaller.java
@@ -9,8 +9,7 @@ import java.io.* ;
*/
public class InlineJavaPerlCaller {
private InlineJavaServer ijs = InlineJavaServer.GetInstance() ;
- private Thread creator ;
- private boolean stop_loop = false ;
+ private Thread creator = null ;
static private HashMap thread_callback_queues = new HashMap() ;
@@ -50,13 +49,10 @@ public class InlineJavaPerlCaller {
// Enqueue the callback into the creator thread's queue and notify it
// that there is some work for him.
ijc.ClearResponse() ;
- ArrayList queue = GetQueue(creator) ;
- synchronized (queue){
- InlineJavaUtils.debug(3, "enqueing callback for processing for " + creator.getName() + " in " + t.getName() + "...") ;
- EnqueueCallback(queue, ijc) ;
- InlineJavaUtils.debug(3, "notifying that a callback request is available for " + creator.getName() + " in " + t.getName() + " (monitor = " + this + ")") ;
- queue.notify() ;
- }
+ InlineJavaCallbackQueue q = GetQueue(creator) ;
+ InlineJavaUtils.debug(3, "enqueing callback for processing for " + creator.getName() + " in " + t.getName() + "...") ;
+ q.EnqueueCallback(ijc) ;
+ InlineJavaUtils.debug(3, "notifying that a callback request is available for " + creator.getName() + " in " + t.getName()) ;
// Now we must wait until the callback is processed and get back the result...
return ijc.WaitForResponse(t) ;
@@ -70,45 +66,27 @@ public class InlineJavaPerlCaller {
throw new InlineJavaException("InlineJavaPerlCaller.StartCallbackLoop() can only be called by threads that communicate directly with Perl") ;
}
- ArrayList queue = GetQueue(t) ;
- stop_loop = false ;
- while (! stop_loop){
- synchronized (queue){
- while (! CheckForCallback(queue)){
- try {
- InlineJavaUtils.debug(3, "waiting for callback request in " + t.getName() + " (monitor = " + this + ")...") ;
- queue.wait() ;
- InlineJavaUtils.debug(3, "waiting for callback request finished " + t.getName() + " (monitor = " + this + ")...") ;
- }
- catch (InterruptedException ie){
- // Do nothing, return and wait() some more...
- }
- }
- InlineJavaUtils.debug(3, "processing callback request in " + t.getName() + "...") ;
- ProcessCallback(t, queue) ;
+ InlineJavaCallbackQueue q = GetQueue(t) ;
+ q.StartLoop() ;
+ while (! q.IsLoopStopped()){
+ InlineJavaUtils.debug(3, "waiting for callback request in " + t.getName() + "...") ;
+ InlineJavaCallback ijc = q.WaitForCallback() ;
+ InlineJavaUtils.debug(3, "waiting for callback request finished " + t.getName() + "...") ;
+ InlineJavaUtils.debug(3, "processing callback request in " + t.getName() + "...") ;
+ // The callback object can be null if the wait() is interrupted by StopCallbackLoop
+ if (ijc != null){
+ ijc.Process() ;
+ ijc.NotifyOfResponse(t) ;
}
}
}
- private boolean CheckForCallback(ArrayList q) throws InlineJavaException, InlineJavaPerlException {
- return (q.size() > 0) ;
- }
-
-
- private void ProcessCallback(Thread t, ArrayList q) throws InlineJavaException, InlineJavaPerlException {
- InlineJavaCallback ijc = DequeueCallback(q) ;
- if (ijc != null){
- ijc.Process() ;
- ijc.NotifyOfResponse(t) ;
- }
- }
-
-
public void StopCallbackLoop() throws InlineJavaException {
- ArrayList queue = GetQueue(creator) ;
- stop_loop = true ;
- queue.notify() ;
+ Thread t = Thread.currentThread() ;
+ InlineJavaCallbackQueue q = GetQueue(creator) ;
+ InlineJavaUtils.debug(3, "interrupting callback loop for " + creator.getName() + " in " + t.getName()) ;
+ q.StopLoop() ;
}
@@ -117,7 +95,7 @@ public class InlineJavaPerlCaller {
calls this method also.
*/
static synchronized void AddThread(Thread t){
- thread_callback_queues.put(t, new ArrayList()) ;
+ thread_callback_queues.put(t, new InlineJavaCallbackQueue()) ;
}
@@ -126,25 +104,12 @@ public class InlineJavaPerlCaller {
}
- static private ArrayList GetQueue(Thread t) throws InlineJavaException {
- ArrayList a = (ArrayList)thread_callback_queues.get(t) ;
+ static private InlineJavaCallbackQueue GetQueue(Thread t) throws InlineJavaException {
+ InlineJavaCallbackQueue q = (InlineJavaCallbackQueue)thread_callback_queues.get(t) ;
- if (a == null){
+ if (q == null){
throw new InlineJavaException("Can't find thread " + t.getName() + "!") ;
}
- return a ;
- }
-
-
- static synchronized void EnqueueCallback(ArrayList q, InlineJavaCallback ijc) throws InlineJavaException {
- q.add(ijc) ;
- }
-
-
- static synchronized InlineJavaCallback DequeueCallback(ArrayList q) throws InlineJavaException {
- if (q.size() > 0){
- return (InlineJavaCallback)q.remove(0) ;
- }
- return null ;
+ return q ;
}
}
diff --git a/README b/README
index 86c4725..2e0b792 100644
--- a/README
+++ b/README
@@ -70,6 +70,11 @@ WARNING: THIS IS ALPHA SOFTWARE. It is incomplete and possibly unreliable.
It is also possible that some elements of the interface (API) will
change in future releases.
+Inline::Java version 0.44 is a major upgrade that includes:
++ Fixed memory leak in JNI coded (patch submitted by Dave Blob)
++ Fixed STUDY that was sometimes not studying (.jdat issue)
++ Callbacks from multiple threads are now supported.
+
Inline::Java version 0.43 is a minor upgrade that includes:
+ Restored $VERSION in each .pm file
+ Inline::Java now formerly requires Perl 5.6
diff --git a/TODO b/TODO
index f223220..e449c8f 100644
--- a/TODO
+++ b/TODO
@@ -1,6 +1,9 @@
CODE:
- Do more test for CLASSPATH combinations
- Document PRIVATE mode
+- Validate information in the cache once and for all.
+- Fix the callback queue bug. the stop_loop variable should be associated
+ with the thread/queue instead of the current object.
TEST:
- Alpha
diff --git a/t/12_callbacks.t b/t/12_callbacks.t
index b99cbaf..00c1c9b 100755
--- a/t/12_callbacks.t
+++ b/t/12_callbacks.t
@@ -7,6 +7,7 @@ use Inline Config =>
use Inline (
Java => 'DATA',
PORT => 17890,
+ STUDY => ['org.perl.inline.java.InlineJavaPerlCaller'],
STARTUP_DELAY => 20,
) ;
@@ -14,13 +15,15 @@ use Inline::Java qw(caught) ;
BEGIN {
- my $cnt = 20 ;
+ my $cnt = 23 ;
if ($ENV{PERL_INLINE_JAVA_JNI}){
$cnt-- ;
}
plan(tests => $cnt) ;
}
+my $mtc_cnt = 0 ;
+my $mtc_mode = 0 ;
my $t = new t15() ;
{
@@ -65,9 +68,30 @@ my $t = new t15() ;
ok($t->perlt()->add(5, 6), 11) ;
if (! $ENV{PERL_INLINE_JAVA_JNI}){
- # This a fatal error under JNI.
+ # This a fatal error under JNI since we cannot croak inside callbacks
+ # because there is some Java in the stack (see JNI.xs, jni_callback for
+ # more info).
eval {$t->perldummy()} ; ok($@, qr/Can't propagate non-/) ;
}
+
+ $t->mtc_callbacks(20) ;
+ $t->StartCallbackLoop() ;
+ ok($mtc_cnt, 20) ;
+
+ $mtc_cnt = -30 ;
+ $t->mtc_callbacks2(50) ;
+ $t->StartCallbackLoop() ;
+ ok($mtc_cnt, 20) ;
+
+ $mtc_cnt = 0 ;
+ $mtc_mode = 1 ;
+ $t->mtc_callbacks2(20) ;
+ $t->StartCallbackLoop() ;
+ ok($mtc_cnt, 20) ;
+
+ # Unfortunately we can't test this because the Thread.run method doesn't allow us
+ # to throw any exceptions...
+ # $t->mtc_callbacks_error() ;
} ;
if ($@){
if (caught("java.lang.Throwable")){
@@ -165,6 +189,21 @@ sub dummy {
+sub mt_callback {
+ my $pc = shift ;
+ $mtc_cnt++ ;
+ if ($mtc_cnt >= 20){
+ if (! $mtc_mode){
+ $pc->StopCallbackLoop() ;
+ }
+ else{
+ my $o = new org::perl::inline::java::InlineJavaPerlCaller() ;
+ $o->StopCallbackLoop() ;
+ }
+ }
+}
+
+
__END__
__Java__
@@ -180,6 +219,33 @@ class t15 extends InlineJavaPerlCaller {
}
}
+ class OwnThread extends Thread {
+ InlineJavaPerlCaller pc = null ;
+ boolean error = false ;
+
+ OwnThread(InlineJavaPerlCaller _pc, int nb, boolean err){
+ super("CALLBACK-TEST-THREAD-#" + nb) ;
+ pc = _pc ;
+ error = err ;
+ }
+
+ public void run(){
+ try {
+ if (! error){
+ pc.CallPerl("main", "mt_callback", new Object [] {pc}) ;
+ }
+ else {
+ new InlineJavaPerlCaller() ;
+ }
+ }
+ catch (InlineJavaException ie){
+ ie.printStackTrace() ;
+ }
+ catch (InlineJavaPerlException ipe){
+ ipe.printStackTrace() ;
+ }
+ }
+ }
public t15() throws InlineJavaException {
}
@@ -301,4 +367,24 @@ class t15 extends InlineJavaPerlCaller {
public Object perldummy() throws InlineJavaException, InlineJavaPerlException, OwnException {
return CallPerl("main", "dummy", null) ;
}
+
+ public void mtc_callbacks(int n){
+ for (int i = 0 ; i < n ; i++){
+ OwnThread t = new OwnThread(this, i, false) ;
+ t.start() ;
+ }
+ }
+
+ public void mtc_callbacks2(int n) throws InlineJavaException, InlineJavaPerlException {
+ for (int i = 0 ; i < n ; i++){
+ InlineJavaPerlCaller pc = new InlineJavaPerlCaller() ;
+ OwnThread t = new OwnThread(pc, i, false) ;
+ t.start() ;
+ }
+ }
+
+ public void mtc_callbacks_error(){
+ OwnThread t = new OwnThread(this, 0, true) ;
+ t.start() ;
+ }
}
--
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