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 07b1377227b5124245e60dbdcc9818069960468a
Author: Patrick LeBoutillier <p...@cpan.org>
Date:   Mon Jan 14 17:34:30 2002 +0000

    Initial revision
---
 bug/croak_bug.pl   | 581 +++++++++++++++++++++++++++++++++++++++++++++++++++++
 bug/gcj_test.class | Bin 0 -> 1843 bytes
 bug/gcj_test.java  |  56 ++++++
 gcj/java           |   3 +
 gcj/javac          |   3 +
 5 files changed, 643 insertions(+)

diff --git a/bug/croak_bug.pl b/bug/croak_bug.pl
new file mode 100644
index 0000000..f7ef525
--- /dev/null
+++ b/bug/croak_bug.pl
@@ -0,0 +1,581 @@
+#!/usr/local/perl56/bin/perl -w
+
+use strict ;
+
+package class ;
+@class::ISA = qw(Inline::Java::Object) ;
+
+use Carp ;
+
+
+$SIG{__DIE__} = sub {
+       $Inline::Java::DONE = 1 ;
+       die @_ ;
+} ;
+
+
+sub new {
+       my $class = shift ;
+       my @args = @_ ;
+
+       my $o = $Inline::Java::INLINE->{'$modfname'} ;
+
+       my $ret = undef ;
+       eval {
+               $ret = $class->__new() ;
+       } ;
+       croak $@ if $@ ;
+
+       return $ret ;
+}
+
+
+
+package Inline::Java::Object ;
+@Inline::Java::Object::ISA = qw(Inline::Java::Object::Tie) ;
+
+use strict ;
+
+$Inline::Java::Object::VERSION = '0.10' ;
+
+use Carp ;
+
+
+# Here we store as keys the knots and as values our blessed private objects
+my $PRIVATES = {} ;
+
+
+# Bogus constructor. We fall here if no public constructor is defined
+# in the Java class.
+sub new {
+       my $class = shift ;
+       
+       croak "No public constructor defined for class $class" ;
+}
+
+
+# Constructor. Here we create a new object that will be linked
+# to a real Java object.
+sub __new {
+       my $class = shift ;
+       my $java_class = shift ;
+       my $inline = shift ;
+       my $objid = shift ;
+       my $proto = shift ;
+       my $args = shift ;
+
+       my %this = () ;
+
+       my $knot = tie %this, $class ;
+       my $this = bless(\%this, $class) ;
+
+       my $priv = Inline::Java::Object::Private->new($java_class, $inline) ;
+       $PRIVATES->{$knot} = $priv ;
+
+       croak "frog" ;
+}
+
+
+sub __get_private {
+       my $this = shift ;
+       
+       my $knot = tied(%{$this}) || $this ;
+
+       my $priv = $PRIVATES->{$knot} ;
+       if (! defined($priv)){
+               croak "Unknown Java object reference" ;
+       }
+
+       return $priv ;
+}
+
+
+# Here an object in destroyed. this function seems to be called twice
+# for each object. I think it's because the $this reference is both blessed
+# and tied to the same package.
+sub DESTROY {
+       my $this = shift ;
+       
+       print STDERR "DESTROY\n" ;
+       if (! $Inline::Java::DONE){
+               if (! $this->__get_private()->{deleted}){
+                       $this->__get_private()->{deleted} = 1 ;
+                       eval {
+                               
$this->__get_private()->{proto}->DeleteJavaObject($this) ;
+                       } ;
+                       croak "In method DESTROY of class 
$this->__get_private()->{class}: $@" if $@ ;
+               }
+               else{
+                       # Inline::Java::debug("Object destructor called more 
than once for $this !") ;
+               }
+       }
+
+       untie %{$this} ;
+}
+
+
+
+######################## Hash Methods ########################
+package Inline::Java::Object::Tie ;
+@Inline::Java::Object::Tie::ISA = qw(Tie::StdHash) ;
+
+
+use Tie::Hash ;
+use Carp ;
+
+
+sub TIEHASH {
+       my $class = shift ;
+
+       return $class->SUPER::TIEHASH(@_) ;
+}
+
+
+sub STORE {
+       my $this = shift ;
+       my $key = shift ;
+       my $value = shift ;
+
+       return $this->__set_member($key, $value) ;
+}
+
+
+sub FETCH {
+       my $this = shift ;
+       my $key = shift ;
+
+       return $this->__get_member($key) ;
+}
+
+
+sub FIRSTKEY { 
+       my $this = shift ;
+
+       return $this->SUPER::FIRSTKEY() ;
+}
+
+
+sub NEXTKEY { 
+       my $this = shift ;
+
+       return $this->SUPER::NEXTKEY() ;
+}
+
+
+sub EXISTS { 
+       my $this = shift ;
+       my $key = shift ;
+
+       my $inline = $Inline::Java::INLINE->{$this->__get_private()->{module}} ;
+       my $fields = $inline->get_fields($this->__get_private()->{java_class}) ;
+
+       if ($fields->{$key}){
+               return 1 ;
+       }
+       
+       return 0 ;
+}
+
+
+sub DELETE { 
+       my $this = shift ;
+       my $key = shift ;
+
+       croak "Operation DELETE not supported on Java object" ;
+}
+
+
+sub CLEAR { 
+       my $this = shift ;
+
+       croak "Operation CLEAR not supported on Java object" ;
+}
+
+
+sub DESTROY {
+       my $this = shift ;
+
+       $PRIVATES->{$this} = undef ;
+}
+
+
+
+
+######################## Private Object ########################
+package Inline::Java::Object::Private ;
+
+sub new {
+       my $class = shift ;
+       my $java_class = shift ;
+       my $inline = shift ;
+       
+       my $this = {} ;
+       $this->{class} = $class ;
+       $this->{java_class} = $java_class ;
+       $this->{module} = $inline->{modfname} ;
+       $this->{known_to_perl} = 1 ;
+       $this->{proto} = new Inline::Java::Protocol($this, $inline) ;
+
+       bless($this, $class) ;
+
+       return $this ;
+}
+
+
+package Inline::Java::Protocol ;
+
+
+use strict ;
+
+$Inline::Java::Protocol::VERSION = '0.10' ;
+
+use Carp ;
+
+
+sub new {
+       my $class = shift ;
+       my $obj = shift ;
+       my $inline = shift ;
+
+       my $this = {} ;
+       $this->{obj_priv} = $obj || {} ;
+       $this->{module} = $inline->{modfname} ;
+
+       bless($this, $class) ;
+       return $this ;
+}
+
+
+sub ISA {
+       my $this = shift ;
+       my $proto = shift ;
+
+       Inline::Java::debug("checking if $this is a $proto") ;
+
+       my $id = $this->{obj_priv}->{id} ;
+       my $class = $this->{obj_priv}->{java_class} ;
+       my $data = join(" ", 
+               "isa", 
+               $id,
+               Inline::Java::Class::ValidateClass($class),
+               Inline::Java::Class::ValidateClass($proto),
+       ) ;
+
+       Inline::Java::debug("  packet sent is $data") ;
+
+       return $this->Send($data, 1) ;
+}
+
+
+# Called to create a Java object
+sub CreateJavaObject {
+       my $this = shift ;
+       my $class = shift ;
+       my $proto = shift ;
+       my $args = shift ;
+
+       Inline::Java::debug("creating object new $class" . 
$this->CreateSignature($args)) ;     
+
+       my $data = join(" ", 
+               "create_object", 
+               Inline::Java::Class::ValidateClass($class),
+               $this->CreateSignature($proto, ","),
+               $this->ValidateArgs($args),
+       ) ;
+
+       Inline::Java::debug("  packet sent is $data") ;
+
+       return $this->Send($data, 1) ;
+}
+
+
+# Called to call a static Java method
+sub CallStaticJavaMethod {
+       my $this = shift ;
+       my $class = shift ;
+       my $method = shift ;
+       my $proto = shift ;
+       my $args = shift ;
+
+       Inline::Java::debug("calling $class.$method" . 
$this->CreateSignature($args)) ;
+
+       my $data = join(" ", 
+               "call_static_method", 
+               Inline::Java::Class::ValidateClass($class),
+               $this->ValidateMethod($method),
+               $this->CreateSignature($proto, ","),
+               $this->ValidateArgs($args),
+       ) ;
+
+       Inline::Java::debug("  packet sent is $data") ;         
+
+       return $this->Send($data) ;
+}
+
+
+# Calls a regular Java method.
+sub CallJavaMethod {
+       my $this = shift ;
+       my $method = shift ;
+       my $proto = shift ;
+       my $args = shift ;
+
+       my $id = $this->{obj_priv}->{id} ;
+       my $class = $this->{obj_priv}->{java_class} ;
+       Inline::Java::debug("calling object($id).$method" . 
$this->CreateSignature($args)) ;
+
+       my $data = join(" ", 
+               "call_method", 
+               $id,
+               Inline::Java::Class::ValidateClass($class),
+               $this->ValidateMethod($method),
+               $this->CreateSignature($proto, ","),
+               $this->ValidateArgs($args),
+       ) ;
+
+       Inline::Java::debug("  packet sent is $data") ;
+
+       return $this->Send($data) ;
+}
+
+
+# Sets a member variable.
+sub SetJavaMember {
+       my $this = shift ;
+       my $member = shift ;
+       my $proto = shift ;
+       my $arg = shift ;
+
+       my $id = $this->{obj_priv}->{id} ;
+       my $class = $this->{obj_priv}->{java_class} ;
+       Inline::Java::debug("setting object($id)->{$member} = $arg->[0]") ;
+       my $data = join(" ", 
+               "set_member", 
+               $id,
+               Inline::Java::Class::ValidateClass($class),
+               $this->ValidateMember($member),
+               Inline::Java::Class::ValidateClass($proto->[0]),
+               $this->ValidateArgs($arg),
+       ) ;
+
+       Inline::Java::debug("  packet sent is $data") ;
+
+       return $this->Send($data) ;
+}
+
+
+# Gets a member variable.
+sub GetJavaMember {
+       my $this = shift ;
+       my $member = shift ;
+       my $proto = shift ;
+
+       my $id = $this->{obj_priv}->{id} ;
+       my $class = $this->{obj_priv}->{java_class} ;
+       Inline::Java::debug("getting object($id)->{$member}") ;
+
+       my $data = join(" ", 
+               "get_member", 
+               $id,
+               Inline::Java::Class::ValidateClass($class),
+               $this->ValidateMember($member),
+               Inline::Java::Class::ValidateClass($proto->[0]),
+               "undef:",
+       ) ;
+
+       Inline::Java::debug("  packet sent is $data") ;
+
+       return $this->Send($data) ;
+}
+
+
+# Deletes a Java object
+sub DeleteJavaObject {
+       my $this = shift ;
+       my $obj = shift ;
+
+       if (defined($this->{obj_priv}->{id})){
+               my $id = $this->{obj_priv}->{id} ;
+               my $class = $this->{obj_priv}->{java_class} ;
+
+               Inline::Java::debug("deleting object $obj $id ($class)") ;
+
+               my $data = join(" ", 
+                       "delete_object", 
+                       $id,
+               ) ;
+
+               Inline::Java::debug("  packet sent is $data") ;         
+
+               $this->Send($data) ;
+       }
+}
+
+
+# This method makes sure that the method we are asking for
+# has the correct form for a Java method.
+sub ValidateMethod {
+       my $this = shift ;
+       my $method = shift ;
+
+       if ($method !~ /^(\w+)$/){
+               croak "Invalid Java method name $method" ;
+       }       
+
+       return $method ;
+}
+
+
+# This method makes sure that the member we are asking for
+# has the correct form for a Java member.
+sub ValidateMember {
+       my $this = shift ;
+       my $member = shift ;
+
+       if ($member !~ /^(\w+)$/){
+               croak "Invalid Java member name $member" ;
+       }       
+
+       return $member ;
+}
+
+
+# Validates the arguments to be used in a method call.
+sub ValidateArgs {
+       my $this = shift ;
+       my $args = shift ;
+
+       my @ret = () ;
+       foreach my $arg (@{$args}){
+               if (! defined($arg)){
+                       push @ret, "undef:" ;
+               }
+               elsif (ref($arg)){
+                       if ((! UNIVERSAL::isa($arg, 
"Inline::Java::Object"))&&(! UNIVERSAL::isa($arg, "Inline::Java::Array"))){
+                               croak "A Java method or member can only have 
Java objects, Java arrays or scalars as arguments" ;
+                       }
+
+                       if (UNIVERSAL::isa($arg, "Inline::Java::Array")){
+                               $arg = $arg->__get_object() ; 
+                       }
+                       my $class = $arg->__get_private()->{java_class} ;
+                       my $id = $arg->__get_private()->{id} ;
+                       push @ret, "object:$class:$id" ;
+               }
+               else{
+                       push @ret, "scalar:" . join(".", unpack("C*", $arg)) ;
+               }
+       }
+
+       return @ret ;
+}
+
+
+sub CreateSignature {
+       my $this = shift ;
+       my $proto = shift ;
+       my $del = shift || ", " ;
+
+       return "(" . join($del, @{$proto}) . ")" ;
+}
+
+
+# This actually sends the request to the Java program. It also takes
+# care of registering the returned object (if any)
+sub Send {
+       my $this = shift ;
+       my $data = shift ;
+       my $const = shift ;
+
+       my $resp = undef ;
+       my $inline = $Inline::Java::INLINE->{$this->{module}} ;
+       if (! $inline->{Java}->{JNI}){
+               my $sock = $inline->{Java}->{socket} ;
+               print $sock $data . "\n" or
+                       croak "Can't send packet over socket: $!" ;
+
+               $resp = <$sock> ;
+       }
+       else{
+               $resp = $inline->{Java}->{JNI}->process_command($data) ;
+       }
+
+       Inline::Java::debug("  packet recv is $resp") ;
+
+       if (! $resp){
+               croak "Can't receive packet over socket: $!" ;
+       }
+       elsif ($resp =~ /^error scalar:([\d.]*)$/){
+               my $msg = pack("C*", split(/\./, $1)) ;
+               Inline::Java::debug("  packet recv error: $msg") ;
+               croak $msg ;
+       }
+       elsif ($resp =~ /^ok scalar:([\d.]*)$/){
+               return pack("C*", split(/\./, $1)) ;
+       }
+       elsif ($resp =~ /^ok undef:$/){
+               return undef ;
+       }
+       elsif ($resp =~ /^ok object:(\d+):(.*)$/){
+               # Create the Perl object wrapper and return it.
+               my $id = $1 ;
+               my $class = $2 ;
+
+               if ($const){
+                       $this->{obj_priv}->{java_class} = $class ;
+                       $this->{obj_priv}->{id} = $id ;
+                       
+                       return undef ;
+               }
+               else{
+                       my $perl_class = $class ;
+                       $perl_class =~ s/[.\$]/::/g ;
+                       my $pkg = $inline->{pkg} ;
+                       $perl_class = $pkg . "::" . $perl_class ;
+                       Inline::Java::debug($perl_class) ;
+
+                       my $known = 0 ;
+                       {
+                               no strict 'refs' ;
+                               if (defined(${$perl_class . "::" . "EXISTS"})){
+                                       Inline::Java::debug("  returned class 
exists!") ;
+                                       $known = 1 ;
+                               }
+                               else{
+                                       Inline::Java::debug("  returned class 
doesn't exist!") ;
+                               }
+                       }
+
+                       my $obj = undef ;
+                       if ($known){
+                               Inline::Java::debug("creating stub for known 
object...") ;
+                               $obj = $perl_class->__new($class, $inline, $id) 
;
+                               Inline::Java::debug("stub created ($obj)...") ;
+                       }
+                       else{
+                               Inline::Java::debug("creating stub for unknown 
object...") ;
+                               $obj = Inline::Java::Object->__new($class, 
$inline, $id) ;
+                               Inline::Java::debug("stub created ($obj)...") ;
+                               $obj->__get_private()->{known_to_perl} = 0 ;
+                       }
+
+                       Inline::Java::debug("checking if stub is array...") ;
+                       if (Inline::Java::Class::ClassIsArray($class)){
+                               Inline::Java::debug("creating array object...") 
;
+                               $obj = new Inline::Java::Array($obj) ;
+                               Inline::Java::debug("array object created...") ;
+                       }
+
+                       Inline::Java::debug("returning stub...") ;
+
+                       return $obj ;
+               }
+       }
+}
+
+
+
+package main ;
+
+my $o = new class() ;
+
diff --git a/bug/gcj_test.class b/bug/gcj_test.class
new file mode 100644
index 0000000..fad3e96
Binary files /dev/null and b/bug/gcj_test.class differ
diff --git a/bug/gcj_test.java b/bug/gcj_test.java
new file mode 100644
index 0000000..5c265b3
--- /dev/null
+++ b/bug/gcj_test.java
@@ -0,0 +1,56 @@
+import java.lang.reflect.* ;
+
+
+public class gcj_test {
+       public static void main(String[] args){
+               try     {
+                       obj o = new obj() ;
+                       Class c = Class.forName("obj") ;
+
+                       Method methods[] = c.getMethods() ;
+                       Field fields[] = c.getFields() ;
+                       Method m = null ;
+                       Field f = null ;
+                       for (int i = 0 ; i < methods.length ; i++){
+                               if (methods[i].getName().equals("f")){
+                                       m = methods[i] ;
+                                       break ;
+                               }
+                       }
+                       for (int i = 0 ; i < fields.length ; i++){
+                               if (fields[i].getName().equals("s")){
+                                       f = fields[i] ;
+                                       break ;
+                               }
+                       }
+
+
+                       Object a[] = {"test"} ;
+                       m.invoke(o, a) ;
+                       f.set(o, "test") ;
+                       System.out.println("s set to 'test'") ;
+                       System.out.println("s = " + (String)f.get(o)) ;
+                       a[0] = null ;
+                       m.invoke(o, a) ;
+                       f.set(o, null) ;
+                       System.out.println("s set to null") ;
+                       System.out.println("s = " + (String)f.get(o)) ;
+                       f.get(o) ;
+               }
+               catch (Exception e){
+                       System.err.println(e.getClass().getName() + ": " + 
e.getMessage()) ;
+                       System.exit(1) ;
+               }
+
+               System.out.println("Done") ;
+       }
+}
+
+
+class obj {
+       public String s = null ;
+
+       public void f(String s){
+               System.out.println("f invoked with param " + s) ;
+       }
+}
\ No newline at end of file
diff --git a/gcj/java b/gcj/java
new file mode 100755
index 0000000..920bfed
--- /dev/null
+++ b/gcj/java
@@ -0,0 +1,3 @@
+#!/bin/sh
+
+/home/patrickl/apps/gcc-3.0.1/bin/gij $@
diff --git a/gcj/javac b/gcj/javac
new file mode 100755
index 0000000..36ae053
--- /dev/null
+++ b/gcj/javac
@@ -0,0 +1,3 @@
+#!/bin/sh
+
+/home/patrickl/apps/gcc-3.0.1/bin/gcj -C $@

-- 
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