/[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.7 by wakaba, Fri Mar 17 08:06:20 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 342  $db->free; Line 340  $db->free;
340  undef $db;  undef $db;
341  status_msg "done";  status_msg "done";
342    
343    undef $limpl;
344    undef $impl;
345    
346  {  {
347    use integer;    use integer;
348    my $time = time - $start_time;    my $time = time - $start_time;
# Line 598  sub daf_generate_perl_test_file ($) { Line 599  sub daf_generate_perl_test_file ($) {
599    $pl->license_uri ($mod->get_property_resource (ExpandedURI q<dis:License>)    $pl->license_uri ($mod->get_property_resource (ExpandedURI q<dis:License>)
600                          ->uri);                          ->uri);
601    
602      $pack->append_code ('
603        use Getopt::Long;
604        my %Skip;
605        GetOptions (
606          "Skip=s" => sub {
607            shift;
608            for (split /\s+/, shift) {
609              if (/^(\d+)-(\d+)$/) {
610                $Skip{$_} = 1 for $1..$2;
611              } else {
612                $Skip{$_} = 1;
613              }
614            }
615          },
616        );
617      ');
618    
619    $pack->append_code    $pack->append_code
620      ($pc->create_perl_statement      ($pc->create_perl_statement
621         ('my $impl = $Message::DOM::ImplementationRegistry->get_implementation ({         ('my $impl = $Message::DOM::ImplementationRegistry->get_implementation ({
# Line 617  sub daf_generate_perl_test_file ($) { Line 635  sub daf_generate_perl_test_file ($) {
635    
636      if ($res->is_type_uri (ExpandedURI q<test:Test>)) {      if ($res->is_type_uri (ExpandedURI q<test:Test>)) {
637        if ($res->is_type_uri (ExpandedURI q<test:StandaloneTest>)) {        if ($res->is_type_uri (ExpandedURI q<test:StandaloneTest>)) {
638          $total_tests++;          my $test_num = ++$total_tests;
639            my $test_uri = $res->name_uri || $res->uri;
640    
641          $pack->append_code ('$test->start_new_test (');          $pack->append_code ('$test->start_new_test (');
642          $pack->append_new_pc_literal ($res->name_uri || $res->uri);          $pack->append_new_pc_literal ($test_uri);
643          $pack->append_code (');');          $pack->append_code (');');
644    
645            $pack->append_code ('if (not $Skip{'.$test_num.'} and not $Skip{');
646            $pack->append_new_pc_literal ($test_uri);
647            $pack->append_code ('}) {');
648                    
649          $pack->append_code ('try {');          $pack->append_code ('try {');
650                    
# Line 641  sub daf_generate_perl_test_file ($) { Line 665  sub daf_generate_perl_test_file ($) {
665            $test->not_ok;            $test->not_ok;
666          };');          };');
667    
668            $pack->append_code ('} else { warn "'.$test_num.' skipped\n" }');
669    
670        } elsif ($res->is_type_uri (ExpandedURI q<test:ParserTestSet>)) {        } elsif ($res->is_type_uri (ExpandedURI q<test:ParserTestSet>)) {
671          my $block = $pack->append_new_pc_block;          my $block = $pack->append_new_pc_block;
672          my @test;          my @test;
Legend:
Removed from v.1.6  
changed lines
  Added in v.1.7
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24