[java2perl6] r81 committed - Cast java::lang::Object to perl Object instead of Any....

Revision: 81
Author: tim.bunce
Date: Mon Aug 10 10:18:12 2009
Log: Cast java::lang::Object to perl Object instead of Any.
Don't set cast_parent if parent is Object.
Don't output needless "is java::lang::Object"
Cleanup related whitespace.
Refactor code that determines what modules to load so same logic is applied  
to all references types.
(I've broken the /Array of/ hack for now as I suspect it should be  
elsewhere.)
All tests pass for me

http://code.google.com/p/java2perl6/source/detail?r=81

Modified:
  /trunk/lib/Java/Javap/Generator/Std.pm
  /trunk/lib/Java/Javap/TypeCast.pm
  /trunk/t/03_class.t

=======================================
--- /trunk/lib/Java/Javap/Generator/Std.pm	Tue Aug  4 16:18:14 2009
+++ /trunk/lib/Java/Javap/Generator/Std.pm	Mon Aug 10 10:18:12 2009
@@ -7,6 +7,15 @@

  use Data::Dumper::Simple;

+# http://perlcabal.org/syn/S02.html#Built-In_Data_Types
+# XXX having this info here is suboptimal
+# should at least be integrated with TypeCaster
+my $perl_builtin_types = { map { $_=>1 } qw(
+    Any Object
+    Bool Int Num Complex Rat Str Bit Regex Set Block List Seq
+    Scalar Array Hash Buf Routine Module
+) };
+
  sub new {
      my $class   = shift;
      my $debug   = shift;
@@ -80,7 +89,8 @@
      my $ast     = shift;

      my $type_caster = $self->{type_caster};
-    $ast->{cast_parent} = defined $ast->{parent} ?  
$type_caster->cast($ast->{parent}) : '';
+    my $class_parent = defined $ast->{parent} ?  
$type_caster->cast($ast->{parent}) : '';
+    $ast->{cast_parent} = ($class_parent eq 'Object') ? '' : $class_parent;
      foreach my $element (@{$ast->{contents}}) {
          #$element->{name} =~ s/\$/_/g	if defined $element->{name};
              next unless $element->{body_element} eq 'method';
@@ -137,41 +147,46 @@
      my $ast  = shift;
      my $type_caster = shift;

-    my %mod;
-    my %ignore = ( Str => 1, Int => 1, Bool => 1, Num => 1, Any => 1, void  
=> 1, qq{$ast->{perl_qualified_name}} => 1);
-
-    #print STDERR "class/role='$ast->{perl_qualified_name}' ignore ='",  
join(', ', keys %ignore), "\n", Dumper($ast);
-
-    my $target;
+    my %perl_types;
      if (defined $ast->{parent}) {
-        $target = $type_caster->cast($ast->{parent});
-        $mod{$target}++ unless $ignore{$target};
+        my $target = $type_caster->cast($ast->{parent});
+        $perl_types{$target}++;
      }

      foreach my $element (@{$ast->{contents}}) {

          next unless $element->{body_element} eq 'method';
-        $target = $type_caster->cast($element->{returns}->{name});
-
-        next if $ignore{$target};
-
-        # at the moment rakudo does not support 'Array of' so don't  
include the
-        # dependency on the class as it will just return Array at the  
moment.
-        next if $element->{returns}->{array_text} =~ /Array of/;
-        next if $target =~ /\$/;
-        $mod{$target}++;
-    }
-
-    foreach my $element (@{$ast->{contents}}) {
-        next unless $element->{body_element} eq 'method';
+
+        my $target = $type_caster->cast($element->{returns}->{name});
+        $perl_types{$target}++;
+
          foreach my $arg (@{$element->{args}}) {
-            $target = $type_caster->cast($arg->{name});
-            next if $ignore{$target};
-            $mod{$target}++;
+            my $target = $type_caster->cast($arg->{name});
+            $perl_types{$target}++;
          }
      }
-    return keys %mod;
-}
+    #warn "$ast->{perl_qualified_name} references types: @{[  
keys %perl_types ]}\n";
+
+    for my $perl_type (keys %perl_types) {
+
+        delete $perl_types{$perl_type}
+            if $perl_builtin_types->{$perl_type}
+            # our own class name
+            or $perl_type eq $ast->{perl_qualified_name}
+            # private java class
+            or $perl_type =~ /\$/
+            # void java class
+            or $perl_type eq 'void'
+            # at the moment rakudo does not support 'Array of' so don't  
include the
+            # dependency on the class as it will just return Array at the  
moment.
+            #or $element->{returns}->{array_text} =~ /Array of/;
+            ;
+    }
+    #warn "$ast->{perl_qualified_name} needs to load: @{[ keys %perl_types  
]}\n";
+
+    return (sort keys %perl_types);
+}
+

  sub _get_template {
      my $self = shift;
@@ -224,7 +239,7 @@
  use [% package -%];
  [% END %]

-class [% ast.perl_qualified_name %]  [% ast.cast_parent  
== '' ? '' : 'is' %] [% ast.cast_parent %] {
+class [% ast.perl_qualified_name %] [%- ast.cast_parent  
== '' ? '' : 'is' %][% ast.cast_parent -%] {
  [% FOREACH element IN ast.method_list %]
      [% ast.methods.${ element.name } > 1 ? 'multi ' : '' %]method [%  
element.name %](
  [% arg_counter = 0 %]
=======================================
--- /trunk/lib/Java/Javap/TypeCast.pm	Tue Aug  4 16:26:20 2009
+++ /trunk/lib/Java/Javap/TypeCast.pm	Mon Aug 10 10:18:12 2009
@@ -11,7 +11,7 @@
      float              => 'Num',
      double             => 'Num',
      boolean            => 'Bool',
-    'java.lang.Object' => 'Any',
+    'java.lang.Object' => 'Object',
      'java.lang.String' => 'Str',
      'java.lang.Number'  => 'Num',
      'java.lang.Class'  => 'Any',
=======================================
--- /trunk/t/03_class.t	Mon Aug 10 09:47:21 2009
+++ /trunk/t/03_class.t	Mon Aug 10 10:18:12 2009
@@ -158,9 +158,7 @@
  #use Data::Dumper::Simple;
  #diag($perl_6);
  my @correct_perl_6 = split /\n/, <<'EO_Correct_Perl_6';
-use java::lang::Object;
-
-class ClassTest  is java::lang::Object {
+class ClassTest {
      multi method getGreet(
          Int $v1,
       --> Str    #  Str
@@ -199,9 +197,7 @@
    my @perl_6 = split /\n/, $perl_6;
  #  diag("got: $perl_6");
    my @correct_perl_6 = split /\n/, <<'EO_Correct_Perl_6_a';
-use java::lang::Object;
-
-class dupMethodTest  is java::lang::Object {
+class dupMethodTest {
      multi method dupMethod(
          Str @v1,
       --> Str    #  Str