/[suikacvs]/messaging/manakai/bin/daf.pl
Suika

Diff of /messaging/manakai/bin/daf.pl

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.6 by wakaba, Thu Mar 16 08:52:31 2006 UTC revision 1.9 by wakaba, Sat Apr 1 14:41:29 2006 UTC
# Line 278  daf_check_undefined (); Line 278  daf_check_undefined ();
278    
279  undef $DNi;  undef $DNi;
280  undef %ModuleSourceDNLDocument;  undef %ModuleSourceDNLDocument;
 undef $limpl;  
 undef $impl;  
281  exit $HasError if $HasError;  exit $HasError if $HasError;
282    
283  ## --- Creating Files  ## --- Creating Files
# Line 295  for (@{$Opt{create_module}}) { Line 293  for (@{$Opt{create_module}}) {
293    
294    if ($out_type eq 'perl-pm') {    if ($out_type eq 'perl-pm') {
295      status_msg_ qq<Generating Perl module from <$mod_uri> for <$mod_for>...>;      status_msg_ qq<Generating Perl module from <$mod_uri> for <$mod_for>...>;
296        local $Message::Util::DIS::Perl::Implementation
297            = $impl->get_feature (ExpandedURI q<Util:PerlCode> => '1.0');
298      my $pl = $mod->pl_generate_perl_module_file;      my $pl = $mod->pl_generate_perl_module_file;
299      status_msg qq<done>;      status_msg qq<done>;
300    
# Line 342  $db->free; Line 342  $db->free;
342  undef $db;  undef $db;
343  status_msg "done";  status_msg "done";
344    
345    undef $limpl;
346    undef $impl;
347    
348  {  {
349    use integer;    use integer;
350    my $time = time - $start_time;    my $time = time - $start_time;
# Line 480  sub daf_get_referring_module_uri_list ($ Line 483  sub daf_get_referring_module_uri_list ($
483  sub dac_search_file_path_stem ($$$) {  sub dac_search_file_path_stem ($$$) {
484    my ($ns, $ln, $suffix) = @_;    my ($ns, $ln, $suffix) = @_;
485    require File::Spec;    require File::Spec;
486    for my $dir ('.', @{$Opt{input_search_path}->{$ns}||[]}) {    for my $dir (@{$Opt{input_search_path}->{$ns}||[]}) {
487      my $name = Cwd::abs_path      my $name = Cwd::abs_path
488          (File::Spec->canonpath          (File::Spec->canonpath
489           (File::Spec->catfile ($dir, $ln)));           (File::Spec->catfile ($dir, $ln)));
# Line 586  sub daf_check_undefined () { Line 589  sub daf_check_undefined () {
589  sub daf_generate_perl_test_file ($) {  sub daf_generate_perl_test_file ($) {
590    my $mod = shift;    my $mod = shift;
591    my $pc = $impl->get_feature (ExpandedURI q<Util:PerlCode> => '1.0');    my $pc = $impl->get_feature (ExpandedURI q<Util:PerlCode> => '1.0');
592      local $Message::Util::DIS::Perl::Implementation = $pc;
593    my $pl = $pc->create_perl_file;    my $pl = $pc->create_perl_file;
594    my $pack = $pl->get_last_package ("Manakai::Test", make_new_package => 1);    my $pack = $pl->get_last_package ("Manakai::Test", make_new_package => 1);
595    $pack->add_use_perl_module_name ("Message::Util::DIS::Test");    $pack->add_use_perl_module_name ("Message::Util::DIS::Test");
# Line 598  sub daf_generate_perl_test_file ($) { Line 602  sub daf_generate_perl_test_file ($) {
602    $pl->license_uri ($mod->get_property_resource (ExpandedURI q<dis:License>)    $pl->license_uri ($mod->get_property_resource (ExpandedURI q<dis:License>)
603                          ->uri);                          ->uri);
604    
605      $pack->append_code ('
606        use Getopt::Long;
607        my %Skip;
608        GetOptions (
609          "Skip=s" => sub {
610            shift;
611            for (split /\s+/, shift) {
612              if (/^(\d+)-(\d+)$/) {
613                $Skip{$_} = 1 for $1..$2;
614              } else {
615                $Skip{$_} = 1;
616              }
617            }
618          },
619        );
620      ');
621    
622    $pack->append_code    $pack->append_code
623      ($pc->create_perl_statement      ($pc->create_perl_statement
624         ('my $impl = $Message::DOM::ImplementationRegistry->get_implementation ({         ('my $impl = $Message::DOM::ImplementationRegistry->get_implementation ({
# Line 617  sub daf_generate_perl_test_file ($) { Line 638  sub daf_generate_perl_test_file ($) {
638    
639      if ($res->is_type_uri (ExpandedURI q<test:Test>)) {      if ($res->is_type_uri (ExpandedURI q<test:Test>)) {
640        if ($res->is_type_uri (ExpandedURI q<test:StandaloneTest>)) {        if ($res->is_type_uri (ExpandedURI q<test:StandaloneTest>)) {
641          $total_tests++;          my $test_num = ++$total_tests;
642            my $test_uri = $res->name_uri || $res->uri;
643    
644          $pack->append_code ('$test->start_new_test (');          $pack->append_code ('$test->start_new_test (');
645          $pack->append_new_pc_literal ($res->name_uri || $res->uri);          $pack->append_new_pc_literal ($test_uri);
646          $pack->append_code (');');          $pack->append_code (');');
647    
648            $pack->append_code ('if (not $Skip{'.$test_num.'} and not $Skip{');
649            $pack->append_new_pc_literal ($test_uri);
650            $pack->append_code ('}) {');
651                    
652          $pack->append_code ('try {');          $pack->append_code ('try {');
653                    
# Line 641  sub daf_generate_perl_test_file ($) { Line 668  sub daf_generate_perl_test_file ($) {
668            $test->not_ok;            $test->not_ok;
669          };');          };');
670    
671            $pack->append_code ('} else { warn "'.$test_num.' skipped\n" }');
672    
673        } elsif ($res->is_type_uri (ExpandedURI q<test:ParserTestSet>)) {        } elsif ($res->is_type_uri (ExpandedURI q<test:ParserTestSet>)) {
674          my $block = $pack->append_new_pc_block;          my $block = $pack->append_new_pc_block;
675          my @test;          my @test;
Legend:
Removed from v.1.6  
changed lines
  Added in v.1.9
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24