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 <p...@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,@_) ;
+    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

_______________________________________________
Pkg-perl-cvs-commits mailing list
Pkg-perl-cvs-commits@lists.alioth.debian.org
http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-perl-cvs-commits

Reply via email to