fork download
copy 
  1. #!/usr/bin/perl -w
  2.  
  3. # yukicoder tester ver.5.8 (2015/02/21)
  4. # Copyright (C) 2014 naoki_kp
  5. my $VERSION = "5.8";
  6.  
  7. # コマンドオプションに問題番号を指定すると
  8. # サンプルケースをダウンロードするスクリプト。
  9. # $PNAME への標準入力に各サンプルを突っ込んで一致判定します。
  10. # 自分用なのでカスタマイズ性とか知らない。
  11.  
  12. # [オプション]
  13. # -s : 改行込みで一致判定します。
  14. # -f : サンプルケースを再ダウンロードします。
  15. # -q : テストケースNG時に追加情報を表示しません。
  16. # -v : 各動作メッセージを表示します。また、テストケースOK時でも追加情報を表示します。
  17.  
  18. # 問題番号の後に実行コマンドを指定できます。
  19.  
  20. use strict;
  21. use HTML::TreeBuilder;
  22. use LWP::Simple;
  23. use Getopt::Std;
  24. use File::Path qw/make_path/;
  25. use Time::HiRes qw/gettimeofday/;
  26. use utf8;
  27. $Getopt::Std::STANDARD_HELP_VERSION = 1;
  28.  
  29. binmode STDERR, ':utf8';
  30.  
  31. $| = 1;
  32. my $ESCCR = "\x1b[1;31m";
  33. my $ESCCG = "\x1b[32m";
  34. my $ESCCN = "\x1b[m";
  35.  
  36. # システム定数
  37. my $URLBASE         = 'http://y...content-available-to-author-only...r.me/problems/no/';
  38. my $PROBLEMDIR_FMT  = 'y%04u';      # $PROBLEM_NO
  39. my $SAMPLEDIR_IN    = 'test_in';
  40. my $SAMPLEDIR_OUT   = 'test_out';
  41. my $SAMPLETXT_FMT   = '#sample%02u.txt';  # $CASE_NO
  42. my $STDOUT          = 'stdout.txt';
  43. my $STDERR          = 'stderr.txt';
  44. my $PNAME           = './yukicoder.exe';
  45.  
  46. sub VERSION_MESSAGE{
  47.     print <<"EOD";
  48. ## yukicoder tester ver.$VERSION ##
  49. EOD
  50. }
  51.  
  52. sub HELP_MESSAGE{
  53.     print <<EOD;
  54. [usage]
  55. ./tester.pl [-h | --help | --version]
  56. ./tester.pl [-efstqv] <problem_no> [execution command]
  57.  -e : eps
  58.  -f : force download
  59.  -s : strict mode
  60.  -t : all testcase download(zip)
  61.  -q : quiet
  62.  -v : verbose
  63. EOD
  64.     exit;
  65. }
  66.  
  67. sub gettick {
  68.     my ($sec, $usec) = gettimeofday();
  69.     return $sec * 1000 + $usec / 1000;
  70. }
  71.  
  72. # オプション解析
  73. my %opt;
  74. getopts('e:fhstqv', \%opt);
  75. if($opt{h} || !@ARGV){
  76.     HELP_MESSAGE();
  77. }
  78.  
  79. my $PROBLEM_NO = 0 + shift @ARGV;
  80. my $URL = $URLBASE . $PROBLEM_NO;
  81.  
  82. # 実行パス指定
  83. $PNAME = join " ", @ARGV if(@ARGV);
  84.  
  85. my $dirp = sprintf $PROBLEMDIR_FMT, $PROBLEM_NO;
  86. my $diri = $dirp . "/" . $SAMPLEDIR_IN;
  87. my $diro = $dirp . "/" . $SAMPLEDIR_OUT;
  88. if($opt{f} || ! -d $diri || ! -d $diro){
  89.     print "downloading samples from $URL\n" if($opt{v});
  90.     my $html = get($URL);
  91.     my $tree = HTML::TreeBuilder->new;
  92.     $tree->parse($html);
  93.  
  94.     my @case;
  95.     foreach ($tree->look_down('class','sample')){
  96.         my @sample;
  97.         foreach ($_->look_down('_tag','pre')){
  98.             if(ref $_->content eq 'ARRAY'){
  99.                 push @sample, $_->content->[0];
  100.             } else {
  101.                 push @sample, "";
  102.             }
  103.         }
  104.         while(@sample >= 2){
  105.             my $in = shift @sample;
  106.             my $out = shift @sample;
  107.             push @case, [$in, $out];
  108.         }
  109.         if(@sample){
  110.             print STDERR "warning: フォーマット異常\n";
  111.         }
  112.     }
  113.     my $num = @case;
  114.     if($num == 0){
  115.         print STDERR "サンプルケースがありません。(非公開の問題かもしれません)\n";
  116.         exit(1);
  117.     }
  118.  
  119.     make_path($diri, $diro);
  120.     print " directory: $diri\n" if($opt{v});
  121.     print " directory: $diro\n" if($opt{v});
  122.  
  123.     for(my $i = 0; $i < $num; $i++){
  124.         my $fn = sprintf $SAMPLETXT_FMT, $i+1;
  125.         my $fni = $diri . '/' . $fn;
  126.         my $fno = $diro . '/' . $fn;
  127.         my ($in,$out) = @{$case[$i]};
  128.         print " file: $fn\n" if($opt{v});
  129.         fileout($fni, $in);
  130.         fileout($fno, $out);
  131.     }
  132.     print "download OK.\n" if($opt{v});
  133. }
  134.  
  135. if($opt{t}){
  136.     my $zipname = 'testcase.zip';
  137.     my $URL2 = $URL . "/$zipname";
  138.     print "downloading testcases from $URL2\n" if($opt{v});
  139.     my $data = get($URL2);
  140.     if(substr($data,0,2) ne 'PK'){
  141.         print STDERR "テストケースをダウンロードできませんでした。\n";
  142.         exit(1);
  143.     }
  144.     fileout_raw("$dirp/$zipname", $data);
  145.     if(system("unzip -oq -d $dirp $dirp/$zipname")){
  146.         print STDERR "テストケースの展開に失敗しました。\n";
  147.         exit(1);
  148.     } else {
  149.         print "download OK.\n" if($opt{v});
  150.         unlink "$dirp/$zipname";
  151.     }
  152. }
  153.  
  154. my @caselist;
  155. if(opendir my $dh, $diri){
  156.     while(my $n = readdir $dh){
  157.         next if($n =~ /^\.\.?$/);
  158.         next if(! -f "$diri/$n");
  159.         push @caselist, $n;
  160.     }
  161.     closedir $dh;
  162. }
  163. @caselist = sort {
  164.     my($t1,$n1) = ($a =~ /^(\D*)(\d*)/);
  165.     my($t2,$n2) = ($b =~ /^(\D*)(\d*)/);
  166.     return $t1 ne $t2 ? $t1 cmp $t2 : $n1 <=> $n2;
  167. } @caselist;
  168. my $num = @caselist;
  169. my $maxlen = 0;
  170. foreach (@caselist){
  171.     if($maxlen < length($_)){ $maxlen = length($_); }
  172. }
  173.  
  174. if($PNAME =~ /\.exe$/){
  175.     system("make $PNAME") and die;
  176. }
  177.  
  178. for(my $i = 0; $i < $num; $i++){
  179.     my $fn = $caselist[$i];
  180.     my $fni = $diri . '/' . $fn;
  181.     my $fno = $diro . '/' . $fn;
  182.  
  183.     my $cmd = "$PNAME < $fni > $STDOUT 2> $STDERR";
  184.     my $st = gettick();
  185.     my $ret = system($cmd);
  186.     my $et = gettick();
  187.     my $err = fileread2($STDERR);
  188.     my $result = 1;
  189.     if($ret == 0){
  190.         if(! -f $fno){
  191.             fileout_raw($fno, fileread($STDOUT));
  192.             $result = 3;
  193.         } elsif($opt{e}){
  194.             my $r1 = fileread($fno);    normalize(\$r1);
  195.             my $r2 = fileread($STDOUT); normalize(\$r2);
  196.             my @r1 = split /\n/, $r1;
  197.             my @r2 = split /\n/, $r2;
  198.             if(@r1 == @r2){
  199.                 my $eps = $opt{e};
  200.                 my $n = @r1;
  201.                 my $f = 1;
  202.                 for(my $i = 0; $i < $n; $i++){
  203.                     if(!epschk($r1[$i], $r2[$i], $eps)){ $f = 0; last; }
  204.                 }
  205.                 $result = 0 if $f;
  206.             }
  207.         } elsif($opt{s}){
  208.             my $cmpcmd = "cmp -s $fno $STDOUT";
  209.             my $cmpret = system($cmpcmd);
  210.             $result = 0 if(!$cmpret);
  211.         } else {
  212.             my $r1 = fileread($fno);    normalize(\$r1);
  213.             my $r2 = fileread($STDOUT); normalize(\$r2);
  214.             $result = 0 if($r1 eq $r2);
  215.         }
  216.     } else {
  217.         $result = 2;
  218.     }
  219.     $result = ('OK', 'NG', 'Runtime Error', 'New')[$result];
  220.     if($result ne 'OK'){ $result = "$ESCCR$result$ESCCN"; }
  221.  
  222.     printf "%-*s %s %s\n", $maxlen, $fn, $result, $result eq 'OK' ? int($et-$st)."ms" : "";
  223.     if($opt{v} || $result ne 'OK' && $result ne 'New' && !$opt{q}){
  224.         my $idat = fileread2($fni);
  225.         print "[Input]\n";
  226.         print "$ESCCG$idat$ESCCN";
  227.         my $edat = fileread2($fno);
  228.         print "[Expected Output]\n";
  229.         print "$ESCCG$edat$ESCCN";
  230.         my $odat = fileread2($STDOUT);
  231.         print "[Your Answer]\n";
  232.         print "$ESCCG$odat$ESCCN";
  233.         if($err){
  234.             print "[STDERR]\n";
  235.             print "$ESCCG$err$ESCCN";
  236.         }
  237.         print "\n";
  238.     }
  239. }
  240. unlink $STDOUT, $STDERR;
  241. exit;
  242.  
  243. sub fileread {
  244.     my $fn = shift;
  245.     open my $fh, '<', $fn or die;
  246.     my $tmp = $/; $/ = ''; my $data = <$fh>; $/ = $tmp;
  247.     close $fh;
  248.     return defined $data ? $data : "";
  249. }
  250. sub fileread2 {
  251.     my $fn = shift;
  252.     open my $fh, '<', $fn or die;
  253.     my $data;
  254.     for(1..10){ if(my $l = <$fh>){chomp($l);if(length($l)>100){$l=substr($l,0,100)." ...";};$data.=$l."\n";}else{last;}}
  255.     close $fh;
  256.     return defined $data ? $data : "";
  257. }
  258.  
  259. sub fileout_raw{
  260.     my($fn, $dat) = @_;
  261.     open my $fh, '>', $fn or die;
  262.     binmode $fh;
  263.     print $fh $dat;
  264.     close $fh;
  265. }
  266. sub fileout{
  267.     my($fn, $dat) = @_;
  268.     normalize(\$dat);
  269.     fileout_raw($fn, $dat);
  270. }
  271.  
  272. sub normalize{
  273.     my $ref = shift;
  274.     my $data = "";
  275.     $$ref =~ s/[\r\n]/\n/g;
  276.     $$ref =~ s/^\n//g;
  277.     foreach (split /\n/, $$ref){
  278.         s/^\s+|\s+$//;
  279.         $data .= "$_\n";
  280.     }
  281.     $$ref = $data;
  282. }
  283.  
  284. sub epschk{
  285.     my($p1,$p2,$eps) = @_;
  286.     if($p1 =~ /[^\d\-\.]/){
  287.         return ($p1 eq $p2)
  288.     }
  289.     my $aerr = abs($p1-$p2);
  290.     my $rerr = $p1 != 0 ? abs(($p1-$p2)/$p1) : 0;
  291.     return ($aerr < $eps || ($p1 && $rerr < $eps));
  292. }
  293.  
Not running #stdin #stdout 0s 0KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
Standard output is empty
https://ideone.com/OlIkW4
yukicoder tester
language:
Text (text 6.10)
created:
9 years ago
visibility:
secret

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!