[libinline-java-perl] 59/398: *** empty log message ***

[Jonas Smedegaard]

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 43af2c1335336cab48c87b04d1eb4181fd665d4d
Author: patrick <>
Date:   Wed Apr 11 20:11:40 2001 +0000

    *** empty log message ***
---
 Java/Array.pm  |   2 +-
 Java/Class.pm  |   3 +-
 Java/Object.pm | 113 ++++++++++++++++++++++++++++++++++-----------------------
 3 files changed, 70 insertions(+), 48 deletions(-)

diff --git a/Java/Array.pm b/Java/Array.pm
index 26d46e4..de3fe76 100644
--- a/Java/Array.pm
+++ b/Java/Array.pm
@@ -283,7 +283,7 @@ sub new {
 	my $ref = shift ;
 
 	if (! Inline::Java::Class::ClassIsArray($java_class)){
-		croak "Can't create Inline::Java::Array::Normalizer object for non-array class $java_class" ;
+		croak "Can't create Java array of non-array class $java_class" ;
 	}
 
 	my $this = {} ;
diff --git a/Java/Class.pm b/Java/Class.pm
index 211c068..ea27728 100644
--- a/Java/Class.pm
+++ b/Java/Class.pm
@@ -713,11 +713,10 @@ class InlineJavaClass {
 		String name = p.getName() ;
 
 		if ((ClassIsReference(p))&&(name.startsWith("["))){
+			ijs.debug("  class " + name + " is array") ;
 			return true ;
 		}
 
-		ijs.debug("  class " + name + " is array") ;
-
 		return false ;
 	}
 
diff --git a/Java/Object.pm b/Java/Object.pm
index 232a33f..95b8782 100644
--- a/Java/Object.pm
+++ b/Java/Object.pm
@@ -40,7 +40,7 @@ sub __new {
 	my $priv = Inline::Java::Object::Private->new($class, $java_class, $inline) ;
 	$PRIVATES->{$knot} = $priv ;
 
-	if ($objid <= 0){
+	if ($objid <= -1){
 		eval {
 			$this->__get_private()->{proto}->CreateJavaObject($java_class, $proto, $args) ;
 		} ;		
@@ -64,7 +64,7 @@ sub __get_private {
 
 	my $priv = $PRIVATES->{$knot} ;
 	if (! defined($priv)){
-		croak "Unknown Java object reference" ;
+		croak "Unknown Java object reference $knot" ;
 	}
 
 	return $priv ;
@@ -74,16 +74,24 @@ sub __get_private {
 # Checks to make sure all the arguments can be "cast" to prototype
 # types.
 sub __validate_prototype {
-	my $class = shift ;
+	my $this = shift ;
 	my $method = shift ;
 	my $args = shift ;
-	my $prototypes = shift ;
+	my $protos = shift ;
+	my $static = shift ;
 	my $inline = shift ;
 
 	my $matched_protos = [] ;
 	my $new_arguments = [] ;
 	my $scores = [] ;
 
+	my $prototypes = [] ;
+	foreach my $s (values %{$protos}){
+		if ($static == $s->{STATIC}){
+			push @{$prototypes}, $s->{SIGNATURE} ;
+		}
+	}
+ 
 	my $nb_proto = scalar(@{$prototypes}) ;
 	my @errors = () ;
 	foreach my $proto (@{$prototypes}){
@@ -109,7 +117,7 @@ sub __validate_prototype {
 	}
 
 	if (! scalar(@{$matched_protos})){
-		my $name = (ref($class) ? $class->__get_private()->{class} : $class) ;
+		my $name = $this->__get_private()->{class} ;
 		my $sa = Inline::Java::Protocol->CreateSignature($args) ;
 		my $msg = "In method $method of class $name: Can't find any signature that matches " .
 			"the arguments passed $sa.\nAvailable signatures are:\n"  ;
@@ -158,9 +166,7 @@ sub __get_member {
 	my $fields = $inline->get_fields($this->__get_private()->{java_class}) ;
 
 	if ($fields->{$key}){
-		# Here when the user is requesting a field, we can't know which
-		# one the user wants, so we select the first one.
-		my $proto = $fields->{$key}->[0] ;
+		my $proto = $fields->{$key}->{TYPE} ;
 
 		my $ret = $this->__get_private()->{proto}->GetJavaMember($key, [$proto], [undef]) ;
 		Inline::Java::debug("returning member (" . ($ret || '') . ")") ;
@@ -187,44 +193,12 @@ sub __set_member {
 	my $fields = $inline->get_fields($this->__get_private()->{java_class}) ;
 
 	if ($fields->{$key}){
-		my $list = $fields->{$key} ;
-
-		my $matched_protos = [] ;
-		my $new_arguments = [] ;
-		my $scores = [] ;
-		foreach my $f (@{$list}){
-			my $new_args = undef ;
-			my $score = undef ;
-			eval {
-				($new_args, $score) = Inline::Java::Class::CastArguments([$value], [$f], $this->__get_private()->{module}) ;
-			} ;
-			if ($@){
-				Inline::Java::debug("Error trying to assign member: $@") ;
-				next ;
-			}
-
-			# We passed!
-			push @{$matched_protos}, [$f] ;
-			push @{$new_arguments}, $new_args ;
-			push @{$scores}, $score ;
-		}
-
-		if (! scalar(@{$matched_protos})){
-			my $name = $this->__get_private()->{class} ;
-			my $msg = "For member $key of class $name: Can't assign passed value $value to variable $key. " .
-				"This variable can accept:\n"  ;
-			foreach my $f (@{$list}){
-				$msg .= "\t$f\n" ;
-			}
-			chomp $msg ;
-			croak $msg ;
-		}
-
-		# Amongst the ones that matched, we need to select the one with the 
-		# highest score. For now, the last one will do.
+		my $proto = $fields->{$key}->{TYPE} ;
+		my $new_args = undef ;
+		my $score = undef ;
 
-		my $nb = scalar(@{$matched_protos}) ;
-		$this->__get_private()->{proto}->SetJavaMember($key, $matched_protos->[$nb - 1], $new_arguments->[$nb - 1]) ;
+		($new_args, $score) = Inline::Java::Class::CastArguments([$value], [$proto], $this->__get_private()->{module}) ;
+		$this->__get_private()->{proto}->SetJavaMember($key, [$proto], $new_args) ;
 	}
 	else{
 		my $name = $this->__get_private()->{class} ;
@@ -370,6 +344,55 @@ sub DESTROY {
 
 
 
+######################## Static Member Methods ########################
+package Inline::Java::Object::StaticMember ;
+ at Inline::Java::Object::StaticMember::ISA = qw(Tie::StdScalar) ;
+
+
+use Tie::Scalar ;
+use Carp ;
+
+my $DUMMIES = {} ;
+
+
+sub TIESCALAR {
+	my $class = shift ;
+	my $dummy = shift ;
+	my $name = shift ;
+
+	my $this = $class->SUPER::TIESCALAR(@_) ;
+
+	$DUMMIES->{$this} = [$dummy, $name] ;
+
+	return $this ;
+}
+
+
+sub STORE {
+	my $this = shift ;
+	my $value = shift ;
+
+	my ($obj, $key) = @{$DUMMIES->{$this}} ;
+
+	return $obj->__set_member($key, $value) ;
+}
+
+
+sub FETCH {
+ 	my $this = shift ;
+
+	my ($obj, $key) = @{$DUMMIES->{$this}} ;
+
+	return $obj->__get_member($key) ;
+}
+
+
+sub DESTROY {
+	my $this = shift ;
+}
+
+
+
 ######################## Private Object ########################
 package Inline::Java::Object::Private ;
 

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