plan skip_all => "javap from Java SDK required: $!"
unless Java::Javap->javap_test();
plan tests => 3;
my $parser = Java::Javap::Grammar->new();
my $decomp = Java::Javap->javap('ClassTest', [ qw(-verbose -classpath testjavas) ]);
my $tree = $parser->comp_unit( $decomp )
or die "Error parsing:\n$decomp";
my $expected_tree = {
'parent' => 'java.lang.Object',
'perl_qualified_name' => 'ClassTest',
'qualifiers' => [],
'access' => 'public',
'contents' => [
{
'body_element' => 'variable',
'access' => 'public',
'name' => 'var1',
'type' => {
'array_depth' => 0,
'array_text' => '',
'name' => 'java.lang.String'
}
},
{
'body_element' => 'variable',
'access' => 'protected',
'name' => 'var2',
'type' => {
'array_depth' => 0,
'array_text' => '',
'name' => 'java.lang.String'
}
},
{
'body_element' => 'variable',
'access' => '',
'name' => 'var3',
'type' => {
'array_depth' => 0,
'array_text' => '',
'name' => 'java.lang.String'
}
},
{
'body_element' => 'constructor',
'type' => {
'array_depth' => 0,
'name' => 'ClassTest',
'array_text' => ''
},
'access' => 'public',
'name' => 'new',
'args' => [],
'throws' => [],
'native' => ''
},
{
'body_element' => 'constructor',
'type' => {
'array_depth' => 0,
'name' => 'ClassTest',
'array_text' => ''
},
'access' => 'public',
'name' => 'new',
'args' => [
{
'array_depth' => 1,
'array_text' => 'Array of ',
'name' => 'java.lang.String'
}
],
'throws' => [],
'native' => ''
},
{
'body_element' => 'constructor',
'type' => {
'array_depth' => 0,
'name' => 'ClassTest',
'array_text' => ''
},
'access' => 'public',
'name' => 'new',
'args' => [
{
'array_depth' => 1,
'array_text' => 'Array of ',
'name' => 'java.lang.String'
},
{
'array_depth' => 0,
'array_text' => '',
'name' => 'int'
}
],
'throws' => [],
'native' => ''
},
{
'attrs' => [],
'body_element' => 'method',
'type' => {
'array_depth' => 0,
'array_text' => '',
'name' => 'java.lang.String'
},
'access' => 'public',
'args' => [],
'name' => 'getGreet',
'throws' => []
},
{
'attrs' => [],
'body_element' => 'method',
'type' => {
'array_depth' => 0,
'array_text' => '',
'name' => 'java.lang.String'
},
'access' => 'public',
'args' => [
{
'array_depth' => 0,
'array_text' => '',
'name' => 'int'
}
],
'name' => 'getGreet',
'throws' => []
}
],
'class_or_interface' => 'class',
'compiled_from' => 'ClassTest.java',
'java_qualified_name' => 'ClassTest',
'methods' => {
'getGreet' => 2,
'new' => 3
},
'constructors' => 3,
'implements' => undef
};
is_deeply( $tree, $expected_tree, 'class' )
or print "---vvv---\n".Dumper($tree)."---^^^---\n";
my $generator = Java::Javap::Generator->get_generator( 'Perl6' );
my $perl_6 = $generator->generate(
{
class_file => 'ClassTest',
ast => $tree,
javap_flags =>'--classpath testjavas'
}
);
$perl_6 =~ s/^
$perl_6 =~ s/^\s+//;
my @perl_6 = split /\n/, $perl_6;
my @correct_perl_6 = split /\n/, <<'EO_Correct_Perl_6';
use v6;
role ClassTest {
multi method new (
--> ClassTest # ClassTest
) { ... }
multi method new (
Str @v1, # java.lang.String
--> ClassTest # ClassTest
) { ... }
multi method new (
Str @v1, # java.lang.String
Int $v2, # int
--> ClassTest # ClassTest
) { ... }
multi method getGreet (
--> Str # java.lang.String
) { ... }
multi method getGreet (
Int $v1, # int
--> Str # java.lang.String
) { ... }
};
EO_Correct_Perl_6
eq_or_diff( \@perl_6, \@correct_perl_6, 'emission' )
or print "---vvv---\n$perl_6\n---^^^---\n";
{
my $parser = Java::Javap::Grammar->new();
my $decomp = Java::Javap->javap('dupMethodTest', [ qw(-verbose -classpath testjavas) ]);
my $tree = $parser->comp_unit( $decomp );
my $generator = Java::Javap::Generator->get_generator( 'Perl6' );
my $perl_6 = $generator->generate(
{
class_file => 'dupMethodTest',
ast => $tree,
javap_flags =>'--classpath testjavas',
debug => 1,
}
);
$perl_6 =~ s/^
$perl_6 =~ s/^\s+//;
my @perl_6 = split /\n/, $perl_6;
my @correct_perl_6 = split /\n/, <<'EO_Correct_Perl_6_a';
use v6;
role dupMethodTest {
method INT_CONST (--> Int) is export { 4 }
method FLOAT_CONST (--> Num) is export { 4.2 }
method A_STRING_CONST (--> Str) is export { "A \"string\"" }
method B_STRING_CONST (--> Str) is export { "A 'str' & \u0008ack" }
method new (
--> dupMethodTest # dupMethodTest
) { ... }
multi method dupMethod (
Int $v1, # char
--> Str # java.lang.String
) { ... }
multi method dupMethod (
Str @v1, # java.lang.String
--> Str # java.lang.String
) { ... }
method nonDupedMethod (
Int $v1, # char
--> Int # int
) { ... }
};
EO_Correct_Perl_6_a
eq_or_diff( \@perl_6, \@correct_perl_6, 'emission - duplicate method signatures removed' )
or print "---vvv---\n$perl_6\n---^^^---\n";
}