96 lines
2.0 KiB
Perl
96 lines
2.0 KiB
Perl
use strict;
|
|
use warnings;
|
|
|
|
use File::Spec;
|
|
use Java::JVM::Classfile;
|
|
|
|
use Test::More tests => 29;
|
|
|
|
sub class_name_to_java {
|
|
my ($name) = @_;
|
|
|
|
my $tmp = $name;
|
|
$tmp =~ s/ANTLR::Runtime/org.antlr.runtime/;
|
|
$tmp =~ s/::/./g;
|
|
|
|
return $tmp;
|
|
}
|
|
|
|
sub java_class_name_to_perl {
|
|
my ($name) = @_;
|
|
|
|
my $tmp = $name;
|
|
$tmp =~ s/org\.antlr\.runtime/ANTLR::Runtime/;
|
|
$tmp =~ s/\./::/g;
|
|
|
|
return $tmp;
|
|
}
|
|
|
|
sub resolve_java_class_file {
|
|
my ($name, $basedir) = @_;
|
|
|
|
my $tmp = $name;
|
|
$tmp =~ s!\.!/!g;
|
|
$tmp .= '.class';
|
|
|
|
return File::Spec->catfile($basedir, $tmp);
|
|
}
|
|
|
|
sub java_constant_name_to_perl {
|
|
}
|
|
|
|
sub java_method_name_to_perl {
|
|
my ($name) = @_;
|
|
|
|
if ($name eq '<init>') {
|
|
return 'new';
|
|
}
|
|
# add special cases here
|
|
else {
|
|
my $tmp = $name;
|
|
$tmp =~ s/([a-z])([A-Z])/$1_\L$2\E/g;
|
|
|
|
return $tmp;
|
|
}
|
|
}
|
|
|
|
my @java_class_names = qw(
|
|
org.antlr.runtime.BitSet
|
|
);
|
|
|
|
foreach my $java_class_name (@java_class_names) {
|
|
my $java_class_file = resolve_java_class_file($java_class_name,
|
|
'../../build/rtclasses');
|
|
|
|
my $java_class;
|
|
{
|
|
local $SIG{'__WARN__'} = sub {};
|
|
$java_class = Java::JVM::Classfile->new($java_class_file);
|
|
}
|
|
|
|
my $class_name = java_class_name_to_perl($java_class_name);
|
|
use_ok($class_name);
|
|
print map { "$_\n" } ANTLR::Runtime::BitSet->can();
|
|
print "---\n";
|
|
|
|
eval { $class_name->new() };
|
|
print join "\n", ANTLR::Runtime::BitSet->can();
|
|
print "\n";
|
|
|
|
my $java_fields = $java_class->fields;
|
|
foreach my $java_field (@$java_fields) {
|
|
next if grep { $_ eq 'private' } @{$java_field->access_flags};
|
|
|
|
my $field_name = $java_field->name;
|
|
ok($class_name->can($field_name), $field_name);
|
|
}
|
|
|
|
my $java_methods = $java_class->methods;
|
|
foreach my $java_method (@$java_methods) {
|
|
next if grep { $_ eq 'private' } @{$java_method->access_flags};
|
|
|
|
my $method_name = java_method_name_to_perl($java_method->name);
|
|
ok($class_name->can($method_name), $method_name);
|
|
}
|
|
}
|