[libinline-java-perl] 106/398: *** empty log message ***
Jonas Smedegaard
dr at jones.dk
Thu Feb 26 11:42:54 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 abbdf6504206f002c77642955e25673d1b6b35cc
Author: Patrick LeBoutillier <patl at cpan.org>
Date: Fri Aug 24 13:02:07 2001 +0000
*** empty log message ***
---
Java.pm | 38 +++++++++++++++++++++++++++++---------
Java/Array.pm | 8 +++++---
Java/Class.pm | 32 ++++++++++++++++++++++++++++----
Java/Object.pm | 39 +++++++++++++++++++++++++++++++++++----
TODO | 3 ++-
t/07_polymorph.t | 10 ++++++++--
6 files changed, 107 insertions(+), 23 deletions(-)
diff --git a/Java.pm b/Java.pm
index 8f046e4..69cee11 100644
--- a/Java.pm
+++ b/Java.pm
@@ -7,7 +7,7 @@ package Inline::Java ;
use strict ;
-$Inline::Java::VERSION = '0.22' ;
+$Inline::Java::VERSION = '0.23' ;
# DEBUG is set via the DEBUG config
@@ -104,18 +104,20 @@ END {
# Signal stuff, not really needed with JNI
use sigtrap 'handler', \&done, 'normal-signals' ;
-$SIG{__DIE__} = sub {
+# This whole $SIG{__DIE__} thing doesn't work because it is called
+# even if the die is trapped inside an eval...
+# $SIG{__DIE__} = sub {
# Setting this to -1 will prevent Inline::Java::Object::DESTROY
# from executing it's code for object destruction, since the state
# in possibly unstable.
- $DONE = -1 ;
- die @_ ;
-} ;
+ # $DONE = -1 ;
+# die @_ ;
+# } ;
# To export the cast function.
sub import {
- Inline::Java->export_to_level(1, at _) ;
+ Inline::Java->export_to_level(1, @_) ;
}
@@ -148,9 +150,9 @@ sub _validate {
my $o = shift ;
my $ignore_other_configs = shift ;
- if ($o->get_INLINE_nb() == 1){
- croak "Inline::Java does not currently support multiple Inline sections" ;
- }
+ # if ($o->get_INLINE_nb() == 1){
+ # croak "Inline::Java does not currently support multiple Inline sections" ;
+ # }
if (! exists($o->{ILSM}->{PORT})){
$o->{ILSM}->{PORT} = 7890 ;
@@ -646,6 +648,24 @@ sub set_classpath {
my @cp = split(/$sep/, join($sep, @list)) ;
my %cp = map { ($_ !~ /^\s*$/ ? ($_, 1) : ()) } @cp ;
+ foreach my $k (keys %cp){
+ if ($k =~ /\s*\[PERL_INLINE_JAVA=(.*?)\]\s*/){
+ my $modules = $1 ;
+ Inline::Java::debug(" found special CLASSPATH entry: $modules") ;
+
+ my @modules = split(/\s*,\s*/, $modules) ;
+ my $sep = portable("PATH_SEP") ;
+ my $sep_re = portable("PATH_SEP_RE") ;
+ my $dir = $o->get_config('DIRECTORY') . $sep . "lib" . $sep ."auto" ;
+
+ foreach my $m (@modules){
+ $m =~ s/::/$sep_re/g ;
+ $cp{"$dir$sep$m"} = 1 ;
+ }
+
+ delete $cp{$k} ;
+ }
+ }
$ENV{CLASSPATH} = join($sep, keys %cp) ;
Inline::Java::debug(" classpath: " . $ENV{CLASSPATH}) ;
diff --git a/Java/Array.pm b/Java/Array.pm
index 8a7daf9..a670932 100644
--- a/Java/Array.pm
+++ b/Java/Array.pm
@@ -305,6 +305,7 @@ sub new {
$this->{map} = {} ;
$this->{ref} = $ref ;
$this->{array} = [] ;
+ $this->{score} = 0 ;
bless ($this, $class) ;
@@ -500,8 +501,9 @@ sub ValidateElements {
(UNIVERSAL::isa($elem, "Inline::Java::Object"))||
(! ref($elem))){
$this->CheckMap("BASE_ELEMENT", $level) ;
- $elem = $this->CastArrayArgument($elem) ;
- $array->[$i] = $elem ;
+ my @ret = $this->CastArrayArgument($elem) ;
+ $array->[$i] = $ret[0] ;
+ $this->{score} += $ret[1] ;
}
else{
croak "A Java array can only contain scalars, Java objects or array references" ;
@@ -536,7 +538,7 @@ sub CastArrayArgument {
my ($new_arg, $score) = Inline::Java::Class::CastArgument($arg, $element_class) ;
- return $new_arg ;
+ return ($new_arg, $score) ;
}
diff --git a/Java/Class.pm b/Java/Class.pm
index a5ba5f9..4c59c95 100644
--- a/Java/Class.pm
+++ b/Java/Class.pm
@@ -5,6 +5,9 @@ use strict ;
$Inline::Java::Class::VERSION = '0.22' ;
+$Inline::Java::Class::MAX_SCORE = 10 ;
+
+
use Carp ;
@@ -125,6 +128,8 @@ sub CastArgument {
my $arg_ori = $arg ;
my $proto_ori = $proto ;
+ my $array_score = 0 ;
+
my $sub = sub {
my $array_type = undef ;
if ((defined($arg))&&(UNIVERSAL::isa($arg, "Inline::Java::Class::Cast"))){
@@ -142,6 +147,7 @@ sub CastArgument {
if (UNIVERSAL::isa($arg, "ARRAY")){
if (! UNIVERSAL::isa($arg, "Inline::Java::Array")){
my $an = new Inline::Java::Array::Normalizer($array_type || $proto, $arg) ;
+ $array_score = $an->{score} ;
my $flat = $an->FlattenArray() ;
my $inline = Inline::Java::get_INLINE($module) ;
my $obj = Inline::Java::Object->__new($array_type || $proto, $inline, -1, $flat->[0], $flat->[1]) ;
@@ -257,9 +263,15 @@ sub CastArgument {
return ($arg, 1) ;
}
- # Here we deduce point the more our argument is "far"
+ # Here we deduce points the more our argument is "far"
# from the prototype.
- return ($arg, 7 - ($score * 0.01)) ;
+ if (! UNIVERSAL::isa($arg, "Inline::Java::Array")){
+ return ($arg, 7 - ($score * 0.01)) ;
+ }
+ else{
+ # We need to keep the array score somewhere...
+ return ($arg, $array_score) ;
+ }
}
# Here we are passing a scalar as an object, this is pretty
@@ -269,12 +281,12 @@ sub CastArgument {
} ;
my @ret = $sub->() ;
-
+
if ((defined($arg_ori))&&(UNIVERSAL::isa($arg_ori, "Inline::Java::Class::Cast"))){
# It seems we had casted the variable to a specific type
if ($arg_ori->matches($proto_ori)){
Inline::Java::debug("Type cast match!") ;
- $ret[1] = 10 ;
+ $ret[1] = $Inline::Java::Class::MAX_SCORE ;
}
else{
# We have casted to something that doesn't exactly match
@@ -288,6 +300,18 @@ sub CastArgument {
}
+sub IsMaxArgumentsScore {
+ my $args = shift ;
+ my $score = shift ;
+
+ if ((scalar(@{$args}) * 10) == $score){
+ return 1 ;
+ }
+
+ return 0 ;
+}
+
+
sub ClassIsNumeric {
my $class = shift ;
diff --git a/Java/Object.pm b/Java/Object.pm
index d8c0375..4ce0b64 100644
--- a/Java/Object.pm
+++ b/Java/Object.pm
@@ -122,7 +122,18 @@ sub __validate_prototype {
STATIC => $stat,
IDX => $idx,
} ;
- push @matched, $h ;
+
+ # Tiny optimization: abort if type cast was used and matched for
+ # every parameter
+ if (Inline::Java::Class::IsMaxArgumentsScore($new_args, $score)){
+ Inline::Java::debug("Perfect match found, aborting search") ;
+ @matched = () ;
+ push @matched, $h ;
+ last ;
+ }
+ else{
+ push @matched, $h ;
+ }
}
my $nb_matched = scalar(@matched) ;
@@ -302,12 +313,29 @@ sub DESTROY {
Inline::Java::debug("Destroying Inline::Java::Object::Tie") ;
if (! Inline::Java::get_DONE()){
+ # This one is very tricky:
+ # Here we want to be carefull since this can be called
+ # at scope end, but the scope end might be triggered
+ # by another croak, so we need to record and propagate
+ # the current $@
+ my $prev_dollar_at = $@ ;
eval {
$this->__get_private()->{proto}->DeleteJavaObject($this) ;
} ;
- my $name = $this->__get_private()->{class} ;
- croak "In method DESTROY of class $name: $@" if $@ ;
-
+ if ($@){
+ # We croaked here. Was there already a pending $@?
+ my $name = $this->__get_private()->{class} ;
+ my $msg = "In method DESTROY of class $name: $@" ;
+ if ($prev_dollar_at){
+ $msg = "$prev_dollar_at\n$msg" ;
+ }
+ croak $msg ;
+ }
+ else{
+ # Put back the previous $@
+ $@ = $prev_dollar_at ;
+ }
+
# Here we have a circular reference so we need to break it
# so that the memory is collected.
my $priv = $this->__get_private() ;
@@ -316,6 +344,9 @@ sub DESTROY {
$proto->{obj_priv} = undef ;
$PRIVATES->{$this} = undef ;
}
+ else{
+ Inline::Java::debug(" Script marked as DONE, object destruction not propagated to Java") ;
+ }
}
else{
# Here we can't untie because we still have a reference in $PRIVATES
diff --git a/TODO b/TODO
index dcd88fa..92538db 100644
--- a/TODO
+++ b/TODO
@@ -1,5 +1,6 @@
CODE:
-- Add support for multiple sections (waiting for Inline 0.40)
+- Localize filehandles
+
TEST:
- Add test script for configuration options (other than BIN)
diff --git a/t/07_polymorph.t b/t/07_polymorph.t
index c8b8ddc..0911270 100644
--- a/t/07_polymorph.t
+++ b/t/07_polymorph.t
@@ -5,14 +5,14 @@ use Inline Config =>
DIRECTORY => './_Inline_test';
use Inline(
- Java => 'DATA'
+ Java => 'DATA',
) ;
use Inline::Java qw(cast) ;
BEGIN {
- plan(tests => 15) ;
+ plan(tests => 16) ;
}
@@ -29,6 +29,8 @@ ok($t->f($t->{hm}), "hashmap") ;
ok($t->f(cast("java.lang.Object", $t->{hm})), "object") ;
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") ;
eval {$t->func($t1)} ; ok($@, qr/Can't find any signature/) ;
@@ -101,5 +103,9 @@ class types {
public String f(String o[]){
return "string[]" ;
}
+
+ public String f(double o[]){
+ return "double[]" ;
+ }
}
--
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