[libinline-java-perl] 323/398: ok
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 2ea5517b6b7aae612ab64f57da3655e28f53a868
Author: patrick_leb <>
Date: Wed Jun 2 15:04:58 2004 +0000
ok
---
CHANGES | 2 +
Java.pm | 59 ++++++++++++++++------
Java/Array.pm | 2 +-
Java/Callback.pm | 2 +-
Java/Class.pm | 34 ++++++-------
Java/JNI.pm | 2 +-
Java/JVM.pm | 13 ++---
Java/Object.pm | 14 ++++-
Java/PerlInterpreter/t/02_perl_interpreter.t | 31 +++++++-----
Java/PerlNatives/PerlNatives.pm | 2 +-
Java/Portable.pm | 9 ++--
Java/Protocol.pm | 20 +++++++-
.../org/perl/inline/java/InlineJavaCallback.java | 2 +-
.../org/perl/inline/java/InlineJavaClass.java | 11 ++++
.../inline/java/InlineJavaPerlInterpreter.java | 9 +++-
.../org/perl/inline/java/InlineJavaProtocol.java | 59 +++++++++++++++++-----
t/05_arrays.t | 4 +-
t/07_polymorph.t | 21 +++++---
t/08_study.t | 16 ++++--
t/pod_test.pl | 7 +--
20 files changed, 229 insertions(+), 90 deletions(-)
diff --git a/CHANGES b/CHANGES
index ec43065..3cb8060 100644
--- a/CHANGES
+++ b/CHANGES
@@ -2,10 +2,12 @@ Revision history for Perl extension Inline::Java
------------------------------------------------
0.49
- Added PerlInterpreter: require/eval Perl code directly from Java
+ - Reworked type casting: changes are NOT backwards compatible :(
- Renamed PerlNatives stuff
- Split and updated documentation
- Applied JNI memory leak patch by Jeff Janes
- Added external command line tool to start/stop a SHARED_JVM server
+ - Removed exports from Inline::Java::Portable
0.47 Sat Feb 14 10:00:00 EST 2004
- Fixed bugs in portability code and added HPUX, AIX and Solaris specifics
diff --git a/Java.pm b/Java.pm
index 9aa4b64..564eacf 100644
--- a/Java.pm
+++ b/Java.pm
@@ -2,13 +2,13 @@ package Inline::Java ;
@Inline::Java::ISA = qw(Inline Exporter) ;
# Export the cast function if wanted
- at EXPORT_OK = qw(cast study_classes caught jar j2sdk) ;
+ at EXPORT_OK = qw(cast coerce study_classes caught jar j2sdk) ;
use strict ;
require 5.006 ;
-$Inline::Java::VERSION = '0.48_92' ;
+$Inline::Java::VERSION = '0.48_93' ;
# DEBUG is set via the DEBUG config
@@ -94,8 +94,8 @@ sub import {
exit() ;
}
elsif ($a eq 'so_dirs'){
- print portable('SO_LIB_PATH_VAR') . "=" .
- join(portable('ENV_VAR_PATH_SEP'),
+ print Inline::Java::Portable::portable('SO_LIB_PATH_VAR') . "=" .
+ join(Inline::Java::Portable::portable('ENV_VAR_PATH_SEP'),
Inline::Java::get_default_j2sdk_so_dirs()) ;
exit() ;
}
@@ -151,6 +151,7 @@ sub validate {
$o->set_option('DEBUGGER', 0, 'b', 1, \%opts) ;
$o->set_option('PRIVATE', '', 'b', 1, \%opts) ;
+ $o->set_option('PACKAGE', '', 's', 1, \%opts) ;
my @left_overs = keys(%opts) ;
if (scalar(@left_overs)){
@@ -193,7 +194,7 @@ sub validate {
# Add the -sourcepath runtime option
$o->set_java_config('EXTRA_JAVA_ARGS', $o->get_java_config('EXTRA_JAVA_ARGS') .
" -sourcepath " . $o->get_api('build_dir') .
- portable("ENV_VAR_PATH_SEP_CP") .
+ Inline::Java::Portable::portable("ENV_VAR_PATH_SEP_CP") .
get_source_dir()
) ;
}
@@ -279,6 +280,11 @@ sub get_api {
my $o = shift ;
my $param = shift ;
+ # Allows us to force a specific package...
+ if (($param eq 'pkg')&&($o->get_config('PACKAGE'))){
+ return $o->get_config('PACKAGE') ;
+ }
+
return $o->{API}->{$param} ;
}
@@ -301,7 +307,7 @@ sub build {
# We must grab this before we change to the build dir because
# it could be relative...
- my $server_jar = get_server_jar() ;
+ my $server_jar = Inline::Java::Portable::get_server_jar() ;
# Create the build dir and go there
my $build_dir = $o->get_api('build_dir') ;
@@ -335,8 +341,8 @@ sub build {
# ... and compile it.
my $javac = File::Spec->catfile($o->get_java_config('J2SDK'), 'bin',
- "javac" . portable("EXE_EXTENSION")) ;
- my $redir = portable("IO_REDIR") ;
+ "javac" . Inline::Java::Portable::portable("EXE_EXTENSION")) ;
+ my $redir = Inline::Java::Portable::portable("IO_REDIR") ;
# We need to add all the previous install dirs to the classpath because
# they can access each other.
@@ -347,10 +353,11 @@ sub build {
}
my $cp = $ENV{CLASSPATH} || '' ;
- $ENV{CLASSPATH} = make_classpath($server_jar, @prev_install_dirs, $o->get_java_config('CLASSPATH')) ;
+ $ENV{CLASSPATH} = Inline::Java::Portable::make_classpath($server_jar, @prev_install_dirs, $o->get_java_config('CLASSPATH')) ;
Inline::Java::debug(2, "classpath: $ENV{CLASSPATH}") ;
my $args = "-deprecation " . $o->get_java_config('EXTRA_JAVAC_ARGS') ;
- my $cmd = portable("SUB_FIX_CMD_QUOTES", "\"$javac\" $args -d \"$install_dir\" $source > cmd.out $redir") ;
+ my $cmd = Inline::Java::Portable::portable("SUB_FIX_CMD_QUOTES",
+ "\"$javac\" $args -d \"$install_dir\" $source > cmd.out $redir") ;
if ($o->get_config('UNTAINT')){
($cmd) = $cmd =~ /(.*)/ ;
}
@@ -372,7 +379,7 @@ sub build {
# returned. Therefore a command failure is not detected.
# We need to take care of checking whether there are actually files
# to be copied, and if not will exit the script.
- if (portable('COMMAND_COM')){
+ if (Inline::Java::Portable::portable('COMMAND_COM')){
my @fl = Inline::Java::Portable::find_classes_in_dir($install_dir) ;
if (! scalar(@fl)){
croak "No class files produced. Previous command failed under command.com?" ;
@@ -459,14 +466,15 @@ sub load {
# If the JVM is not running, we need to start it here.
my $cp = $ENV{CLASSPATH} || '' ;
if (! $JVM){
- $ENV{CLASSPATH} = make_classpath(get_server_jar()) ;
+ $ENV{CLASSPATH} = Inline::Java::Portable::make_classpath(
+ Inline::Java::Portable::get_server_jar()) ;
Inline::Java::debug(2, "classpath: $ENV{CLASSPATH}") ;
$JVM = new Inline::Java::JVM($o) ;
$ENV{CLASSPATH} = $cp ;
Inline::Java::debug(2, "classpath: $ENV{CLASSPATH}") ;
my $pc = new Inline::Java::Protocol(undef, $o) ;
- $pc->AddClassPath(portable("SUB_FIX_CLASSPATH", get_user_jar())) ;
+ $pc->AddClassPath(Inline::Java::Portable::portable("SUB_FIX_CLASSPATH", Inline::Java::Portable::get_user_jar())) ;
my $st = $pc->ServerType() ;
if ((($st eq "shared")&&(! $o->get_java_config('SHARED_JVM')))||
@@ -476,7 +484,7 @@ sub load {
}
$ENV{CLASSPATH} = '' ;
- my @cp = make_classpath($install_dir, $o->get_java_config('CLASSPATH')) ;
+ my @cp = Inline::Java::Portable::make_classpath($install_dir, $o->get_java_config('CLASSPATH')) ;
$ENV{CLASSPATH} = $cp ;
my $pc = new Inline::Java::Protocol(undef, $o) ;
@@ -1067,17 +1075,36 @@ sub dump_obj {
######################## Public Functions ########################
+# If we are dealing with a Java object, we simply ask for a new "reference"
+# with the requested class.
sub cast {
my $type = shift ;
my $val = shift ;
+
+ if (! UNIVERSAL::isa($val, "Inline::Java::Object")){
+ croak("Type casting can only be used on Java objects. Use 'coerce' instead.") ;
+ }
+
+ return $val->__cast($type) ;
+}
+
+
+# coerce is used to force a specific prototype to be used.
+sub coerce {
+ my $type = shift ;
+ my $val = shift ;
my $array_type = shift ;
+ if (UNIVERSAL::isa($val, "Inline::Java::Object")){
+ croak("Type coercing can't be used on Java objects. Use 'cast' instead.") ;
+ }
+
my $o = undef ;
eval {
- $o = new Inline::Java::Class::Cast($type, $val, $array_type) ;
+ $o = new Inline::Java::Class::Coerce($type, $val, $array_type) ;
} ;
croak $@ if $@ ;
-
+
return $o ;
}
diff --git a/Java/Array.pm b/Java/Array.pm
index aad867a..0d03b2a 100644
--- a/Java/Array.pm
+++ b/Java/Array.pm
@@ -4,7 +4,7 @@ package Inline::Java::Array ;
use strict ;
use Carp ;
-$Inline::Java::Array::VERSION = '0.48_92' ;
+$Inline::Java::Array::VERSION = '0.48_93' ;
# Here we store as keys the knots and as values our blessed objects
my $OBJECTS = {} ;
diff --git a/Java/Callback.pm b/Java/Callback.pm
index a42a57c..a56c7af 100644
--- a/Java/Callback.pm
+++ b/Java/Callback.pm
@@ -3,7 +3,7 @@ package Inline::Java::Callback ;
use strict ;
use Carp ;
-$Inline::Java::Callback::VERSION = '0.48_92' ;
+$Inline::Java::Callback::VERSION = '0.48_93' ;
$Inline::Java::Callback::OBJECT_HOOK = undef ;
diff --git a/Java/Class.pm b/Java/Class.pm
index 7c308ad..b6f5e17 100644
--- a/Java/Class.pm
+++ b/Java/Class.pm
@@ -3,7 +3,7 @@ package Inline::Java::Class ;
use strict ;
use Carp ;
-$Inline::Java::Class::VERSION = '0.48_92' ;
+$Inline::Java::Class::VERSION = '0.48_93' ;
$Inline::Java::Class::MAX_SCORE = 10 ;
@@ -128,10 +128,10 @@ sub CastArgument {
my $sub = sub {
my $array_type = undef ;
- if ((defined($arg))&&(UNIVERSAL::isa($arg, "Inline::Java::Class::Cast"))){
- my $v = $arg->get_value() ;
- $proto = $arg->get_type() ;
- $array_type = $arg->get_array_type() ;
+ if ((defined($arg))&&(UNIVERSAL::isa($arg, "Inline::Java::Class::Coerce"))){
+ my $v = $arg->__get_value() ;
+ $proto = $arg->__get_type() ;
+ $array_type = $arg->__get_array_type() ;
$arg = $v ;
}
@@ -300,17 +300,17 @@ sub CastArgument {
my @ret = $sub->() ;
- if ((defined($arg_ori))&&(UNIVERSAL::isa($arg_ori, "Inline::Java::Class::Cast"))){
+ if ((defined($arg_ori))&&(UNIVERSAL::isa($arg_ori, "Inline::Java::Class::Coerce"))){
# It seems we had casted the variable to a specific type
- if ($arg_ori->matches($proto_ori)){
- Inline::Java::debug(3, "type cast match!") ;
+ if ($arg_ori->__matches($proto_ori)){
+ Inline::Java::debug(3, "type coerce match!") ;
$ret[1] = $Inline::Java::Class::MAX_SCORE ;
}
else{
- # We have casted to something that doesn't exactly match
+ # We have coerced to something that doesn't exactly match
# any of the available types.
# For now we don't allow this.
- croak "Cast ($proto) doesn't exactly match prototype ($proto_ori)" ;
+ croak "Coerce ($proto) doesn't exactly match prototype ($proto_ori)" ;
}
}
@@ -447,8 +447,8 @@ sub ClassIsArray {
-######################## Inline::Java::Class::Cast ########################
-package Inline::Java::Class::Cast ;
+######################## Inline::Java::Class::Coerce ########################
+package Inline::Java::Class::Coerce ;
use Carp ;
@@ -459,7 +459,7 @@ sub new {
my $value = shift ;
my $array_type = shift ;
- if (UNIVERSAL::isa($value, "Inline::Java::Class::Cast")){
+ if (UNIVERSAL::isa($value, "Inline::Java::Class::Coerce")){
# This allows chaining
$value = $value->get_value() ;
}
@@ -474,27 +474,27 @@ sub new {
}
-sub get_value {
+sub __get_value {
my $this = shift ;
return $this->{value} ;
}
-sub get_type {
+sub __get_type {
my $this = shift ;
return $this->{cast} ;
}
-sub get_array_type {
+sub __get_array_type {
my $this = shift ;
return $this->{array_type} ;
}
-sub matches {
+sub __matches {
my $this = shift ;
my $proto = shift ;
diff --git a/Java/JNI.pm b/Java/JNI.pm
index 5a74016..04d5886 100644
--- a/Java/JNI.pm
+++ b/Java/JNI.pm
@@ -4,7 +4,7 @@ package Inline::Java::JNI ;
use strict ;
-$Inline::Java::JNI::VERSION = '0.48_92' ;
+$Inline::Java::JNI::VERSION = '0.48_93' ;
use DynaLoader ;
use Carp ;
diff --git a/Java/JVM.pm b/Java/JVM.pm
index 07aff53..0325687 100644
--- a/Java/JVM.pm
+++ b/Java/JVM.pm
@@ -6,8 +6,9 @@ use Carp ;
use IO::File ;
use IPC::Open3 ;
use IO::Socket ;
+use Inline::Java::Portable ;
-$Inline::Java::JVM::VERSION = '0.48_92' ;
+$Inline::Java::JVM::VERSION = '0.48_93' ;
my %SIGS = () ;
@@ -68,7 +69,7 @@ sub new {
# Grab the next free port number and release it.
if ((! $this->{shared})&&($this->{port} < 0)){
- if (Inline::Java::portable("GOT_NEXT_FREE_PORT")){
+ if (Inline::Java::Portable::portable("GOT_NEXT_FREE_PORT")){
my $sock = IO::Socket::INET->new(
Listen => 0, Proto => 'tcp',
LocalAddr => 'localhost', LocalPort => 0) ;
@@ -110,11 +111,11 @@ sub new {
my $java = File::Spec->catfile($o->get_java_config('J2SDK'), 'bin',
($this->{debugger} ? "jdb" : "java") .
- Inline::Java::portable("EXE_EXTENSION")) ;
+ Inline::Java::Portable::portable("EXE_EXTENSION")) ;
my $shared = ($this->{shared} ? "true" : "false") ;
my $priv = ($this->{private} ? "true" : "false") ;
- my $cmd = Inline::Java::portable("SUB_FIX_CMD_QUOTES", "\"$java\" $args org.perl.inline.java.InlineJavaServer $debug $this->{port} $shared $priv") ;
+ my $cmd = Inline::Java::Portable::portable("SUB_FIX_CMD_QUOTES", "\"$java\" $args org.perl.inline.java.InlineJavaServer $debug $this->{port} $shared $priv") ;
Inline::Java::debug(2, $cmd) ;
if ($o->get_config('UNTAINT')){
($cmd) = $cmd =~ /(.*)/ ;
@@ -155,7 +156,7 @@ sub launch {
local $SIG{__WARN__} = sub {} ;
- my $dn = Inline::Java::portable("DEV_NULL") ;
+ my $dn = Inline::Java::Portable::portable("DEV_NULL") ;
my $in = ($this->{debugger} ? ">&STDIN" : new IO::File("<$dn")) ;
if (! defined($in)){
croak "Can't open $dn for reading" ;
@@ -261,7 +262,7 @@ sub setup_socket {
my $socket = undef ;
my $last_words = "timeout\n" ;
- my $got_alarm = Inline::Java::portable("GOT_ALARM") ;
+ my $got_alarm = Inline::Java::Portable::portable("GOT_ALARM") ;
eval {
local $SIG{ALRM} = sub { die($last_words) ; } ;
diff --git a/Java/Object.pm b/Java/Object.pm
index 6cebf22..01de9ca 100644
--- a/Java/Object.pm
+++ b/Java/Object.pm
@@ -5,7 +5,7 @@ use strict ;
use Inline::Java::Protocol ;
use Carp ;
-$Inline::Java::Object::VERSION = '0.48_92' ;
+$Inline::Java::Object::VERSION = '0.48_93' ;
# Here we store as keys the knots and as values our blessed private objects
my $PRIVATES = {} ;
@@ -121,7 +121,7 @@ sub __validate_prototype {
IDX => $idx,
} ;
- # Tiny optimization: abort if type cast was used and matched for
+ # Tiny optimization: abort if type coerce was used and matched for
# every parameter
if (Inline::Java::Class::IsMaxArgumentsScore($new_args, $score)){
Inline::Java::debug(3, "perfect match found, aborting search") ;
@@ -227,6 +227,16 @@ sub __isa {
}
+sub __cast {
+ my $this = shift ;
+ my $class = shift ;
+
+ my $ret = $this->__get_private()->{proto}->Cast($class) ;
+
+ return $ret ;
+}
+
+
sub __get_member {
my $this = shift ;
my $key = shift ;
diff --git a/Java/PerlInterpreter/t/02_perl_interpreter.t b/Java/PerlInterpreter/t/02_perl_interpreter.t
index 0d1487f..5624b9d 100644
--- a/Java/PerlInterpreter/t/02_perl_interpreter.t
+++ b/Java/PerlInterpreter/t/02_perl_interpreter.t
@@ -19,14 +19,14 @@ use Inline::Java::Portable ;
ok(1) ;
-my $inline = $Tests::INLINE ;
-$inline = $Tests::INLINE ; # stupid warning...
+my $inline = $org::perl::inline::java::InlineJavaPerlInterpreterTests::INLINE ;
+$inline = $org::perl::inline::java::InlineJavaPerlInterpreterTests::INLINE ; # stupid warning...
my $install_dir = File::Spec->catdir($inline->get_api('install_lib'),
'auto', $inline->get_api('modpname')) ;
require Inline::Java->find_default_j2sdk() ;
-my $server_jar = get_server_jar() ;
+my $server_jar = Inline::Java::Portable::get_server_jar() ;
run_java($install_dir, $server_jar) ;
@@ -37,16 +37,17 @@ run_java($install_dir, $server_jar) ;
sub run_java {
my @cps = @_ ;
- print STDERR "\n" ;
- $ENV{CLASSPATH} = make_classpath(@cps) ;
- # print STDERR "CLASSPATH is $ENV{CLASSPATH}\n" ;
+ $ENV{CLASSPATH} = Inline::Java::Portable::make_classpath(@cps) ;
+ Inline::Java::debug(1, "CLASSPATH is $ENV{CLASSPATH}\n") ;
my $java = File::Spec->catfile(
Inline::Java::get_default_j2sdk(),
- 'bin', 'java' . Inline::Java::portable("EXE_EXTENSION")) ;
+ 'bin', 'java' . Inline::Java::Portable::portable("EXE_EXTENSION")) ;
- my $cmd = Inline::Java::portable("SUB_FIX_CMD_QUOTES", "\"$java\" Tests") ;
- # print STDERR "Command is $cmd\n" ;
+ my $debug = $ENV{PERL_INLINE_JAVA_DEBUG} || 0 ;
+ my $cmd = Inline::Java::Portable::portable("SUB_FIX_CMD_QUOTES", "\"$java\" " .
+ "org.perl.inline.java.InlineJavaPerlInterpreterTests $debug") ;
+ Inline::Java::debug(1, "Command is $cmd\n") ;
print `$cmd` ;
}
@@ -54,11 +55,11 @@ sub run_java {
__END__
__Java__
-import org.perl.inline.java.* ;
+package org.perl.inline.java ;
-class Tests extends InlineJavaPerlInterpreter {
+class InlineJavaPerlInterpreterTests extends InlineJavaPerlInterpreter {
private static int cnt = 2 ;
- private Tests() throws InlineJavaException, InlineJavaPerlException {
+ private InlineJavaPerlInterpreterTests() throws InlineJavaException, InlineJavaPerlException {
}
private static void ok(Object o1, Object o2){
@@ -75,6 +76,12 @@ class Tests extends InlineJavaPerlInterpreter {
public static void main(String args[]){
try {
+ int debug = 0 ;
+ if (args.length > 0){
+ debug = Integer.parseInt(args[0]) ;
+ InlineJavaUtils.debug = debug ;
+ }
+
init("test") ;
InlineJavaPerlInterpreter pi = InlineJavaPerlInterpreter.create() ;
diff --git a/Java/PerlNatives/PerlNatives.pm b/Java/PerlNatives/PerlNatives.pm
index 537f268..d3011bb 100644
--- a/Java/PerlNatives/PerlNatives.pm
+++ b/Java/PerlNatives/PerlNatives.pm
@@ -2,6 +2,6 @@ package Inline::Java::PerlNatives ;
use strict ;
-$Inline::Java::PerlNatives::VERSION = '0.48_92' ;
+$Inline::Java::PerlNatives::VERSION = '0.48_93' ;
1 ;
diff --git a/Java/Portable.pm b/Java/Portable.pm
index 9a03e22..d70dd32 100644
--- a/Java/Portable.pm
+++ b/Java/Portable.pm
@@ -1,7 +1,6 @@
package Inline::Java::Portable ;
@Inline::Java::Portable::ISA = qw(Exporter) ;
- at EXPORT = qw(portable make_classpath get_server_jar get_user_jar get_source_dir) ;
use strict ;
use Exporter ;
@@ -10,7 +9,7 @@ use Config ;
use File::Find ;
use File::Spec ;
-$Inline::Java::Portable::VERSION = '0.48_92' ;
+$Inline::Java::Portable::VERSION = '0.48_93' ;
# Here is some code to figure out if we are running on command.com
# shell under Windows.
@@ -46,7 +45,7 @@ sub make_classpath {
}
push @list, @paths ;
- my $sep = portable("ENV_VAR_PATH_SEP_CP") ;
+ my $sep = Inline::Java::Portable::portable("ENV_VAR_PATH_SEP_CP") ;
my @cp = split(/$sep+/, join($sep, @list)) ;
# Clean up paths
@@ -62,7 +61,7 @@ sub make_classpath {
if (($p)&&(-e $p)){
if ($cp{$p}){
my $fp = (-d $p ? File::Spec->rel2abs($p) : $p) ;
- push @fcp, portable("SUB_FIX_CLASSPATH", $fp) ;
+ push @fcp, Inline::Java::Portable::portable("SUB_FIX_CLASSPATH", $fp) ;
delete $cp{$p} ;
}
}
@@ -213,6 +212,8 @@ sub portable {
},
solaris => {
GOT_NEXT_FREE_PORT => 0,
+ PRE_WHOLE_ARCHIVE => '-Wl,-zallextract',
+ POST_WHOLE_ARCHIVE => '-Wl,-zdefaultextract',
},
aix => {
JVM_LIB => "libjvm$Config{lib_ext}",
diff --git a/Java/Protocol.pm b/Java/Protocol.pm
index ab3b371..5b8f6c2 100644
--- a/Java/Protocol.pm
+++ b/Java/Protocol.pm
@@ -5,7 +5,7 @@ use Inline::Java::Object ;
use Inline::Java::Array ;
use Carp ;
-$Inline::Java::Protocol::VERSION = '0.48_92' ;
+$Inline::Java::Protocol::VERSION = '0.48_93' ;
my %CLASSPATH_ENTRIES = () ;
@@ -157,6 +157,24 @@ sub CallJavaMethod {
}
+# Casts a Java object.
+sub Cast {
+ my $this = shift ;
+ my $class = shift ;
+
+ my $id = $this->{obj_priv}->{id} ;
+ Inline::Java::debug(3, "creating a new reference to object($id) with type $class") ;
+
+ my $data = join(" ",
+ "cast",
+ $id,
+ Inline::Java::Class::ValidateClass($class),
+ ) ;
+
+ return $this->Send($data) ;
+}
+
+
# Sets a member variable.
sub SetJavaMember {
my $this = shift ;
diff --git a/Java/sources/org/perl/inline/java/InlineJavaCallback.java b/Java/sources/org/perl/inline/java/InlineJavaCallback.java
index 1e56051..da23afe 100644
--- a/Java/sources/org/perl/inline/java/InlineJavaCallback.java
+++ b/Java/sources/org/perl/inline/java/InlineJavaCallback.java
@@ -58,7 +58,7 @@ class InlineJavaCallback {
StringBuffer cmdb = new StringBuffer("callback " + via + " " + method + " " + cast.getName()) ;
if (args != null){
for (int i = 0 ; i < args.length ; i++){
- cmdb.append(" " + ijp.SerializeObject(args[i])) ;
+ cmdb.append(" " + ijp.SerializeObject(args[i], null)) ;
}
}
return cmdb.toString() ;
diff --git a/Java/sources/org/perl/inline/java/InlineJavaClass.java b/Java/sources/org/perl/inline/java/InlineJavaClass.java
index bcfaadf..57bd1f6 100644
--- a/Java/sources/org/perl/inline/java/InlineJavaClass.java
+++ b/Java/sources/org/perl/inline/java/InlineJavaClass.java
@@ -1,6 +1,7 @@
package org.perl.inline.java ;
import java.util.* ;
+import java.lang.reflect.* ;
class InlineJavaClass {
@@ -469,4 +470,14 @@ class InlineJavaClass {
return false ;
}
+
+
+ static boolean ClassIsPublic (Class p){
+ int pub = p.getModifiers() & Modifier.PUBLIC ;
+ if (pub != 0){
+ return true ;
+ }
+
+ return false ;
+ }
}
diff --git a/Java/sources/org/perl/inline/java/InlineJavaPerlInterpreter.java b/Java/sources/org/perl/inline/java/InlineJavaPerlInterpreter.java
index ceceb6a..36856b2 100644
--- a/Java/sources/org/perl/inline/java/InlineJavaPerlInterpreter.java
+++ b/Java/sources/org/perl/inline/java/InlineJavaPerlInterpreter.java
@@ -25,7 +25,9 @@ public class InlineJavaPerlInterpreter extends InlineJavaPerlCaller {
protected InlineJavaPerlInterpreter() throws InlineJavaPerlException, InlineJavaException {
init() ;
+ InlineJavaUtils.debug(2, "constructing perl interpreter") ;
construct() ;
+ InlineJavaUtils.debug(2, "perl interpreter constructed") ;
if (! libperl_so.equals("")){
evalNoReturn("require DynaLoader ;") ;
@@ -42,8 +44,12 @@ public class InlineJavaPerlInterpreter extends InlineJavaPerlCaller {
if (instance == null){
// Here we create a temporary InlineJavaServer instance in order to be able to instanciate
// ourselves. When we create InlineJavaPerlInterpreter, the instance will be overriden.
- InlineJavaServer.jni_main(0) ;
+ InlineJavaUtils.debug(2, "creating temporary JNI InlineJavaServer") ;
+ InlineJavaServer.jni_main(InlineJavaUtils.debug) ;
+ InlineJavaUtils.debug(2, "temporary JNI InlineJavaServer created") ;
+ InlineJavaUtils.debug(2, "creating InlineJavaPerlInterpreter") ;
instance = new InlineJavaPerlInterpreter() ;
+ InlineJavaUtils.debug(2, "InlineJavaPerlInterpreter created") ;
}
return instance ;
}
@@ -70,6 +76,7 @@ public class InlineJavaPerlInterpreter extends InlineJavaPerlCaller {
// Load the PerlInterpreter shared object
InlineJavaUtils.debug(2, "loading shared library " + perlinterpreter_so) ;
System.load(perlinterpreter_so) ;
+ InlineJavaUtils.debug(2, "shared library " + perlinterpreter_so + " loaded") ;
libperl_so = GetBundle().getString("inline_java_libperl_so") ;
diff --git a/Java/sources/org/perl/inline/java/InlineJavaProtocol.java b/Java/sources/org/perl/inline/java/InlineJavaProtocol.java
index 1c1118b..287e07a 100644
--- a/Java/sources/org/perl/inline/java/InlineJavaProtocol.java
+++ b/Java/sources/org/perl/inline/java/InlineJavaProtocol.java
@@ -64,6 +64,9 @@ class InlineJavaProtocol {
else if (c.equals("obj_cnt")){
ObjectCount(st) ;
}
+ else if (c.equals("cast")){
+ Cast(st) ;
+ }
else if (c.equals("die")){
InlineJavaUtils.debug(1, "received a request to die...") ;
ijs.Shutdown() ;
@@ -104,8 +107,8 @@ class InlineJavaProtocol {
Method methods[] = c.getMethods() ;
Field fields[] = c.getFields() ;
- int pub = c.getModifiers() & Modifier.PUBLIC ;
- if (pub != 0){
+ boolean pub = ijc.ClassIsPublic(c) ;
+ if (pub){
// If the class is public and has no constructors,
// we provide a default no-arg constructors.
if (c.getDeclaredConstructors().length == 0){
@@ -242,7 +245,7 @@ class InlineJavaProtocol {
o = ijs.GetObject(id) ;
// Use the class of the object
- class_name = o.getClass().getName() ;
+ // class_name = o.getClass().getName() ;
}
Class c = ijc.ValidateClass(class_name) ;
@@ -286,6 +289,20 @@ class InlineJavaProtocol {
/*
+ Returns a new reference to the current object, using the provided subtype
+ */
+ void Cast(StringTokenizer st) throws InlineJavaException {
+ int id = Integer.parseInt(st.nextToken()) ;
+
+ String class_name = st.nextToken() ;
+ Object o = ijs.GetObject(id) ;
+ Class c = ijc.ValidateClass(class_name) ;
+
+ SetResponse(o, c) ;
+ }
+
+
+ /*
Sets a Java member variable
*/
void SetJavaMember(StringTokenizer st) throws InlineJavaException {
@@ -297,7 +314,7 @@ class InlineJavaProtocol {
o = ijs.GetObject(id) ;
// Use the class of the object
- class_name = o.getClass().getName() ;
+ // class_name = o.getClass().getName() ;
}
Class c = ijc.ValidateClass(class_name) ;
@@ -353,7 +370,7 @@ class InlineJavaProtocol {
o = ijs.GetObject(id) ;
// Use the class of the object
- class_name = o.getClass().getName() ;
+ // class_name = o.getClass().getName() ;
}
Class c = ijc.ValidateClass(class_name) ;
@@ -607,19 +624,35 @@ class InlineJavaProtocol {
This sets the response that will be returned to the Perl
script
*/
- void SetResponse (Object o) throws InlineJavaException {
- response = "ok " + SerializeObject(o) ;
+ void SetResponse(Object o) throws InlineJavaException {
+ SetResponse(o, null) ;
}
- String SerializeObject(Object o) throws InlineJavaException {
+ void SetResponse(Object o, Class p) throws InlineJavaException {
+ response = "ok " + SerializeObject(o, p) ;
+ }
+
+
+ String SerializeObject(Object o, Class p) throws InlineJavaException {
+ Class c = (o == null ? null : o.getClass()) ;
+
+ if ((c != null)&&(p != null)){
+ if (ijc.DoesExtend(c, p) < 0){
+ throw new InlineJavaException("Can't cast a " + c.getName() + " to a " + p.getName()) ;
+ }
+ else{
+ c = p ;
+ }
+ }
+
if (o == null){
return "undef:" ;
}
- else if ((ijc.ClassIsNumeric(o.getClass()))||(ijc.ClassIsChar(o.getClass()))||(ijc.ClassIsString(o.getClass()))){
+ else if ((ijc.ClassIsNumeric(c))||(ijc.ClassIsChar(c))||(ijc.ClassIsString(c))){
return "scalar:" + Encode(o.toString()) ;
}
- else if (ijc.ClassIsBool(o.getClass())){
+ else if (ijc.ClassIsBool(c)){
String b = o.toString() ;
return "scalar:" + Encode((b.equals("true") ? "1" : "0")) ;
}
@@ -631,10 +664,12 @@ class InlineJavaProtocol {
if (o instanceof InlineJavaThrown){
thrown = true ;
o = ((InlineJavaThrown)o).GetThrowable() ;
- }
+ c = o.getClass() ;
+ }
int id = ijs.PutObject(o) ;
+
return "java_object:" + (thrown ? "1" : "0") + ":" + String.valueOf(id) +
- ":" + o.getClass().getName() ;
+ ":" + c.getName() ;
}
else {
return "perl_object:" + ((InlineJavaPerlObject)o).GetId() +
diff --git a/t/05_arrays.t b/t/05_arrays.t
index c32b1a7..c3aacf0 100644
--- a/t/05_arrays.t
+++ b/t/05_arrays.t
@@ -87,11 +87,11 @@ my $t = new types5() ;
# This is one of the things that won't work.
# Try passing an array as an Object.
eval {$t->_o(["a", "b", "c"])} ; ok($@, qr/Can't create Java array/) ;
- ok($t->_o(Inline::Java::cast(
+ ok($t->_o(Inline::Java::coerce(
"java.lang.Object",
["a", "b", "c"],
"[Ljava.lang.String;"))->[0], "a") ;
- $t->{o} = Inline::Java::cast(
+ $t->{o} = Inline::Java::coerce(
"java.lang.Object",
["a", "b", "c"],
"[Ljava.lang.String;") ;
diff --git a/t/07_polymorph.t b/t/07_polymorph.t
index a205129..0990f9d 100644
--- a/t/07_polymorph.t
+++ b/t/07_polymorph.t
@@ -6,13 +6,15 @@ use Inline Config =>
use Inline(
Java => 'DATA',
+ STUDY => ['java.util.HashMap'],
+ AUTOSTUDY => 1,
) ;
-use Inline::Java qw(cast) ;
+use Inline::Java qw(cast coerce) ;
BEGIN {
- plan(tests => 22) ;
+ plan(tests => 23) ;
}
@@ -22,10 +24,10 @@ my $t = new types7() ;
my $t1 = new t17() ;
ok($t->func(5), "int") ;
- ok($t->func(cast("char", 5)), "char") ;
+ ok($t->func(coerce("char", 5)), "char") ;
ok($t->func(55), "int") ;
ok($t->func("str"), "string") ;
- ok($t->func(cast("java.lang.StringBuffer", "str")), "stringbuffer") ;
+ ok($t->func(coerce("java.lang.StringBuffer", "str")), "stringbuffer") ;
ok($t->f($t->{hm}), "hashmap") ;
ok($t->f(cast("java.lang.Object", $t->{hm})), "object") ;
@@ -33,10 +35,10 @@ my $t = new types7() ;
ok($t->f(["a", "b", "c"]), "string[]") ;
ok($t->f(["12.34", "45.67"]), "double[]") ;
- ok($t->f(cast("java.lang.Object", ['a'], "[Ljava.lang.String;")), "object") ;
+ ok($t->f(coerce("java.lang.Object", ['a'], "[Ljava.lang.String;")), "object") ;
eval {$t->func($t1)} ; ok($@, qr/Can't find any signature/) ;
- eval {$t->func(cast("int", $t1))} ; ok($@, qr/Can't convert (.*) to primitive int/) ;
+ eval {$t->func(cast("int", $t1))} ; ok($@, qr/Can't cast (.*) to a int/) ;
my $t2 = new t27() ;
ok($t2->f($t2), "t1") ;
@@ -56,6 +58,13 @@ my $t = new types7() ;
# Interfaces
my $al = $t1->get_al() ;
ok(0, $t1->count($al)) ;
+
+ my $hm = new java::util::HashMap() ;
+ $hm->put('key', 'value') ;
+ my $a = $hm->entrySet()->toArray() ;
+ foreach my $e (@{$a}){
+ ok(cast('java.util.Map$Entry', $e)->getKey(), 'key') ;
+ }
}
ok($t->__get_private()->{proto}->ObjectCount(), 1) ;
diff --git a/t/08_study.t b/t/08_study.t
index 9333f34..5ff1fc7 100644
--- a/t/08_study.t
+++ b/t/08_study.t
@@ -34,8 +34,13 @@ use Inline(
STUDY => ['t.types'],
CLASSPATH => '.',
) ;
-
-
+use Inline(
+ Java => 'STUDY',
+ AUTOSTUDY => 1,
+ STUDY => ['t.types'],
+ CLASSPATH => '.',
+ PACKAGE => 'main',
+) ;
package study ;
use Inline::Java qw(study_classes) ;
@@ -43,7 +48,7 @@ use Inline::Java qw(study_classes) ;
BEGIN {
- plan(tests => 9) ;
+ plan(tests => 11) ;
}
study_classes([
@@ -65,6 +70,11 @@ my $t = new study::t::types() ;
ok($a->sa()->[1], 'titi') ;
ok($a->sb()->[0]->get('toto'), 'titi') ;
ok($a->sb()->[1]->get('error'), undef) ;
+
+ my $toto_t = new toto::t::types() ;
+ ok(1) ;
+ my $main_t = new t::types() ;
+ ok(1) ;
}
ok($t->__get_private()->{proto}->ObjectCount(), 1) ;
diff --git a/t/pod_test.pl b/t/pod_test.pl
index 300ee91..60d1f9e 100644
--- a/t/pod_test.pl
+++ b/t/pod_test.pl
@@ -21,6 +21,9 @@ GetOptions (\%opts,
) ;
+my $skip_to = $opts{s} || 0 ;
+my $cnt = -1 ;
+
foreach my $podf ('Java.pod', 'Java/Callback.pod', 'Java/PerlNatives/PerlNatives.pod'){
open(POD, "<$podf") or
die("Can't open $podf file") ;
@@ -31,9 +34,6 @@ foreach my $podf ('Java.pod', 'Java/Callback.pod', 'Java/PerlNatives/PerlNatives
my @code_blocks = ($pod =~ m/$del(.*?)$del/gs) ;
- my $skip_to = $opts{s} || 0 ;
-
- my $cnt = -1 ;
foreach my $code (@code_blocks){
$cnt++ ;
@@ -61,6 +61,7 @@ foreach my $podf ('Java.pod', 'Java/Callback.pod', 'Java/PerlNatives/PerlNatives
"print (((($1) eq ('$2')) ? \"ok\" : \"not ok ('$1' ne '$2')\") . \"\\n\") ;" ;
}/ge ;
+ my $Entry = '$Entry' ;
debug($code) ;
eval $code ;
--
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