--- messaging/manakai/bin/daf.pl 2006/03/16 08:52:31 1.6 +++ messaging/manakai/bin/daf.pl 2006/04/03 12:53:22 1.10 @@ -278,8 +278,6 @@ undef $DNi; undef %ModuleSourceDNLDocument; -undef $limpl; -undef $impl; exit $HasError if $HasError; ## --- Creating Files @@ -295,7 +293,10 @@ if ($out_type eq 'perl-pm') { status_msg_ qq for <$mod_for>...>; - my $pl = $mod->pl_generate_perl_module_file; + local $Message::Util::DIS::Perl::Implementation + = $impl->get_feature (ExpandedURI q => '1.0'); + my $pl = $mod->pl_generate_perl_module_file + ($impl->get_feature (ExpandedURI q => '1.0')); status_msg qq; my $output; @@ -342,6 +343,9 @@ undef $db; status_msg "done"; +undef $limpl; +undef $impl; + { use integer; my $time = time - $start_time; @@ -480,7 +484,7 @@ sub dac_search_file_path_stem ($$$) { my ($ns, $ln, $suffix) = @_; require File::Spec; - for my $dir ('.', @{$Opt{input_search_path}->{$ns}||[]}) { + for my $dir (@{$Opt{input_search_path}->{$ns}||[]}) { my $name = Cwd::abs_path (File::Spec->canonpath (File::Spec->catfile ($dir, $ln))); @@ -586,7 +590,9 @@ sub daf_generate_perl_test_file ($) { my $mod = shift; my $pc = $impl->get_feature (ExpandedURI q => '1.0'); - my $pl = $pc->create_perl_file; + local $Message::Util::DIS::Perl::Implementation = $pc; + my $pl = $pc->create_pc_file; + my $factory = $pl->owner_document; my $pack = $pl->get_last_package ("Manakai::Test", make_new_package => 1); $pack->add_use_perl_module_name ("Message::Util::DIS::Test"); $pack->add_use_perl_module_name ("Message::Util::Error"); @@ -598,6 +604,23 @@ $pl->license_uri ($mod->get_property_resource (ExpandedURI q) ->uri); + $pack->append_code (' + use Getopt::Long; + my %Skip; + GetOptions ( + "Skip=s" => sub { + shift; + for (split /\s+/, shift) { + if (/^(\d+)-(\d+)$/) { + $Skip{$_} = 1 for $1..$2; + } else { + $Skip{$_} = 1; + } + } + }, + ); + '); + $pack->append_code ($pc->create_perl_statement ('my $impl = $Message::DOM::ImplementationRegistry->get_implementation ({ @@ -617,14 +640,20 @@ if ($res->is_type_uri (ExpandedURI q)) { if ($res->is_type_uri (ExpandedURI q)) { - $total_tests++; + my $test_num = ++$total_tests; + my $test_uri = $res->name_uri || $res->uri; + $pack->append_code ('$test->start_new_test ('); - $pack->append_new_pc_literal ($res->name_uri || $res->uri); + $pack->append_new_pc_literal ($test_uri); $pack->append_code (');'); + + $pack->append_code ('if (not $Skip{'.$test_num.'} and not $Skip{'); + $pack->append_new_pc_literal ($test_uri); + $pack->append_code ('}) {'); $pack->append_code ('try {'); - my $test_pc = $res->pl_code_fragment; + my $test_pc = $res->pl_code_fragment ($factory); if (not defined $test_pc) { die "Perl test code not defined for <".$res->uri.">"; } @@ -641,6 +670,8 @@ $test->not_ok; };'); + $pack->append_code ('} else { warn "'.$test_num.' skipped\n" }'); + } elsif ($res->is_type_uri (ExpandedURI q)) { my $block = $pack->append_new_pc_block; my @test; @@ -698,7 +729,7 @@ $_->append_new_pc_literal (\@test); } - my $plc = $res->pl_code_fragment; + my $plc = $res->pl_code_fragment ($factory); unless ($plc) { die "Resource <".$res->uri."> does not have Perl test code"; }