#! /usr/bin/perl -w use strict; $::tests = { version => 8, holes => [ { name => 'rpn', tie => 'trp05', check => [ { in => "1 - -\t2\n", result => '3', out => \&check_rpn }, { in => "1 + 2\n", result => '3', out => \&check_rpn }, { in => "(-1 + 2)\n", result => '1', out => \&check_rpn }, { in => "( -1 + 2)\n", result => '1', out => \&check_rpn }, { in => "1 -2\n", result => '-1', out => \&check_rpn }, { in => "1+2-3\n", result => '0', out => \&check_rpn }, { in => "1 - 2 - 3\n", result => '-4', out => \&check_rpn }, { in => "( 1 + 2)\n", result => '3', out => \&check_rpn }, # Using tabs { in => "\t1\t-\t2\t-\t3\t\n", result => '-4', out => \&check_rpn }, { in => "1-2+5\n", result => '4', out => \&check_rpn }, { in => "1-2+5-2\n", result => '2', out => \&check_rpn }, { in => "(1+(1+(1+(1+(1+(2))))))\n", result => '7', out => \&check_rpn }, # Negative integer literal { in => "1+-5\n", result => '-4', out => \&check_rpn }, { in => "5 * 3\n", result => '15', out => \&check_rpn }, { in => "-2*-5\n", result => '10', out => \&check_rpn }, { in => "2*-5\n", result => '-10', out => \&check_rpn }, { in => "6 / 4\n", result => '1', out => \&check_rpn }, { in => "0 / 1\n", result => '0', out => \&check_rpn }, { in => "1 * 0\n", result => '0', out => \&check_rpn }, { in => "00 + 1\n", result => '1', out => \&check_rpn }, { in => "1 - 00\n", result => '1', out => \&check_rpn }, { in => "00\n", result => '0', out => \&check_rpn }, { in => "-00\n", result => '0', out => \&check_rpn }, { in => "-0001\n", result => '-1', out => \&check_rpn }, # No, it isn't octal... { in => "010\n", result => '10', out => \&check_rpn }, { in => "1 + 2 * 3\n", result => '7', out => \&check_rpn }, { in => "999 -\t888\n", result => '111', out => \&check_rpn }, { in => "3*4+2*3\n", result => '18', out => \&check_rpn }, { in => "3*4/2*3\n", result => '18', out => \&check_rpn }, { in => "3*4/5*3\n", result => '6', out => \&check_rpn }, { in => "3/4*6/3\n", result => '0', out => \&check_rpn }, { in => "3/4*6*3*4*5*6*78\n", result => '0', out => \&check_rpn }, { in => "12/1/2\n", result => '6', out => \&check_rpn }, { in => "(3*4)/(2*3)\n", result => '2', out => \&check_rpn }, { in => "4-(2*(3-(1+1)))\n", result => '2', out => \&check_rpn }, { in => "1*2*3*4*5*6*7/6/5/4/3\n", result => '14', out => \&check_rpn }, { in => "0*6+-0/5+1-00000--2\n", result => '3', out => \&check_rpn }, { in => "(05)+5*06/2-7\n", result => '13', out => \&check_rpn }, { in => "999999/1000*67-56*80*8\n", result => '31093', out => \&check_rpn }, { in => "1*2*3-3*2*1+4/5-5/4+9*6/6*9\n", result => '80', out => \&check_rpn }, { in => "9998999/1000*67-56*80*8000+6666*6969-4657/250*780*890\n", result => '-1210380', out => \&check_rpn }, # And then a few big ones. If a bug is caught by one # of these, it'll probably be almost impossible to # track the actual reason down. { in => "(18*16*16*5-1+12+15+18*1-8+6/7-6-2-(19)*(17))+8+((9/14))*16+15*11*13/20*4+16-7-19+9+(12)+(4)+20-1*(16)+(6)+19*13/1*6*5/17-17+(2)*6*4-19*17-4*(1-20*11*3*19+3/(8+9*20/16+(16)/8/3))-((3))*(6+2-(17)*2*2-(10))*(14-15*4+6/11-10*4+13)*9-5-6*17-9-20+15*17-17-(1)*18-19+16*20+20+(18-2)/14+(10)*10+14+(3*10)-16/17/10+15*3+(1+9)/8+8*4+(2)-19-12*13-5+14/20-17*(13)/5-18/3+5-14+16+7-19-7*(9+3/1/13)*1+(1*20+9/4)+1/17*16/4/17-3-9-((8)*19/3*13*4/1-19*8*16/1+18+7-14+((14-13)/11-10/9+3+((10*6))))*((12+4-12/17-3/6+((17))-((10))-8/9-17+1))*2\n", result => "-67497", out => \&check_rpn }, { in => "((9)*5*7-6+9-(19)*16*10+3*13+(11*15)*9+15+13-20+(8)-((16)-(13)*2*14)-(((12/16*7+15-1/18-16/17)/4-15)))*4+((4/12-17-18))-(19)/(12*6)/10*20*16/(19)*12+20/7-6+(6*5)/8*11*3/8+14/(((13)/12+7))+(2-11-17/14*19-9*(11)/(14*2/1/18))-13+10+5/20+9*((14)-(9))-(15-3-(20)-8)-5+(16*11/10/8+19)+13+13-13*12-19/(1)+3+2*(12)*6-8-(20/3)/(13-10/5-18)+(9*2/20/11/18-6/15/20-11+6*10/8+9+3/1+(4)*10*7-(4)+16-20*(1)-19/9*9/2*(20/6-15*14)*(10-(11/1)+11-16/7-((6)-17)-(1/1)-2))\n", result => '26711', out => \&check_rpn }, { in => "12-(14)-(11/(1/8*12-9)+(6)+14+13-7)*((18-18-3)+((16-14))/(10+16+10+9-17/13*14-16))+1+16*20/(15)+16+12*19/19+6*(3)*11*6*13/4-7-19-17-(12)*12/3*19/(5)+9/15/1/(5)/13/11-12-10*((14))*(9)*8-15+7+12+11-18+20+15/3+19+(19)+20/10-5+15+16/1/6*12/12/(19)*7*12-(1)/(17-5*17)*20*11-17*16*7+20/13-14*13-18*19-2+7/11+1/5*11/7/4-11+10/((3+11)*1+16-(16))+((11-8)+16/6*(1)*12+2/10-8*3-10/11)/9+17+(8)/7-15/(((17)))*8/13-5-14*14/11+15*13-8-4*6/20+14/20/19-(6)-12*14+10+16+9*20+9+9/1*5-1+13+11/4+20*9-(16+7)*(15*6*(7)*7+1/15)+15*18/3*(1)-11+5/(10)/5+8*17*10-18*6+9*((19+19))-(10-18/3*16-10*6-12+5/(12)+2/5+3/7+10/15*3-(18)+6*9*7*13+4*16*18)+12+5-(9*12+15*12-7/18+14-11-11*11*(17)+((16))-10-17+7*16+7-19+15-9-2-6-13/3)/5-13/13/14/6*(6)/14*10*(16)*3-13*13-8*20/15*9/7+16*11/(1)/17*11/18+15-((15))*1/6/17*17*16-14/13*18*8-(5)*(8)-15/5+((17))+17/1*6-2+1+6-10-5-((13)-(14)+15)+(14)*13/15/2*5-19-13+13-6*8+6/1*20*1*7+8/(6-19)-8-1/1+11*1/16-9-(((8-19+20/1+5-19+9/13)/12/16-5/19-10-5)-14)/13+9+(9/10)+9+19/17*11*(2+18)+1/14*13+14*15+6-(18/16)+1/9+(1)/11*17*18*12+12+12+(12)*14/9/(19)*9/(15)*(11)-19-12-(17+20+3+15*(5)/15-(15)/9*6/8+16*((14+2-9)/4-13*9-(3)-(10)))*15-1/(19-1-(((14*7+10+(8)))+(14)/(16/(4))+12/(1+1/(17))-(20)/6+17*15+11*10/7)*12+6+13-16-14-9/(7)/7+20+7*15/11+6*13/13+7+18/1+(2-20)*11+(11+6)*(19*18*9+4-((2)))+1/5-1-(17+11/16*18/15)*(17/1*13/10+4)/(12)+11*14+20+8-(10)*2*6*(((16+19*(20))+((18))-13/9/18-14*5-1+6+15+2*12+2/15/8+14-20*8-(13-12))-(4)-17/2-20-11*(15)+7/2-12/15/10/16*20/6*(8+16*20+5+6+14)+19+19/19*10+3))+(((11))*2*6-17*(15)-(6)+(13)-18-(3)*19*18/(3)*3+(19)*15-1+9+13+5*17+17-20/17-13/8+(9-20-6+1+(4/13))/9+((((1/5))*(6+12+17/4)))+7*(((19*10+(2)/17/9-4/14-(9)/13*12-(3+17)+16*6-11-19*11*(19*6)*14+17+19/20+2-1+4*8*(7*7+17-18)/(17+14+5*2)*(17*10)+(17)))-8+8-(5+3*18+12-(18)/18*5-(6*8)/9-20+5-15-16)-(((1)/18-(15))/14-12+15*10/9*19*8*14/3*20-(9)/17+11*11/18)+1)/((((20-2-8+(15)+19-12*1*16+5+4*3+(3)/2*20)))*19))\n", result => '-81184', out => \&check_rpn }, { in => "11+17-16*(15+20-(3)-12+11+3+6*7*8-15-14*(13+13)*10*(9*6)+4*5-(19)*(17)-9*8+5-1-(17)-16*(11*1)*6*14+1*9-5+18+6-1-14)+13*3+10+17+3+4+1*14*6+7*10*4*3-18*8-18-3+19+17-19*4+18-7+7*7+4+16*15*10*19*9-5+6+6+6+(4)*12+19-((9+((19))))-((5)+((19)-1-10-7*6*19*6)+(20-6)-19*20-(8)-16*(3)+4*20-7-9*5-9*6*(7)-19-4*15-20*(1)+(7)*4+20*10*3*9-10-4-12-16*1*18*4+5+17+16-(20)-9+15-15-16+3-9-15-17*14-13-15-15-9-10*(1-8+3+20*14-(5)+(14)-6-9+3+1*1))*2-(19-19)-14-8-16-9-(7*17*19+15)*2+(3-5*4+10)+10*9*15-9-12*10*9-(13)-(5)+1-4*8-13+((5*17-11-10-2+(14)-(15*5-2+14)))+9+(((2))*14+4-6*6+(13-8-3-11)-7+14*11*18+13*5-10-19*15+20+18-11*16-14*19+13+12*12*2-9*(13*8)+15*18*12*13)*6+12-6*9+14*11-9+2-7+15*(18+14)-(2)+((16*2)*19*13-9+17+6+11*12-1)+8-((6+12*5+16-(1-17)))+(((12)*17-4*4+2+7*12*3-15*8-9*7-11+6*1)*6*1+1-8*18*3*10+5+12+18*13+17+5*5-(14+16-10*19)+11*18-14+13+(3*10)-(17)-20*17+(13)+8+19-(14)+4)-17-19*19-20-19*14-16+10*10*6+3-3-11*6+7+5*3+(17)*(7*7+13*5)-8-(16-15*(20)*17+10-(16))+(15)*7*2-1-16+(18)+7*5-18+8-20+8*9+6-6-13-3-19+19*10-(13)+20-12+9+18*10-11-12+5+14*(16*14)*16*3+(1)*(4)+13+1*17*(15)-9-17-18-19-5-2*19-3-7+3+1*18-6*13+12-(18)-18+9-11+12-18+2+2*13+18-15-11-6-20+7*6-10-(1-15*2*7-(14)+2-(8*18-5-10))+1-((19*12-3-(20)+7*5-3*13-1+16-7-9+12+5+17*1*14*3+12*17*9-16*19+15*(2)-19+6+20*12-((15)-(15)+3+3-8*11-19-11-11+15*9+13+2*18)+9-2*6*9+6+13-(4)*(4-3)*16-(9)+17-14-10*15-3*12+15*19+(11)-17*15-(5*2)-(13)*6+3-2-3-5+16*20+16+10-8+17+(8*16)-11*20*8+(16-14-5-17*14-(3-14)*7-17*15*2+3+3-1+6*7*(14*19))*1+(1)+19*16*17-(5)-3+7-11-15+10+1+15+20+12-9*10-(18)*(7)+(13)*14-5-4*19*7*20+5-8-13*6+9-12+18*18+8*2*2+(2*1*18*12-12-3*18-17*12+15*20+4+(6*20-9+14+7+4*3+16-(5)-17-7-14+20-3+11))))-13-(4*14+(15+18)-(11-8+16+11)-(1+16+8-12*15+(12))+(1*2*10-18*15)+6-(19+2+13*9-(13)-6+4-18-3-17+16*10-1+4+12*6*9)+16*11*11*6-(1)*2-6+19-(2*6)*1-15+4-18-15*9*20-15-18-19+15-3*15+8*15+13-11+6+2-((17))*14-8+3*7*20-5-1-4+(4*9*9+6*5*(6))-((13+16+(8)+(2)*16*3+3)))*18-((14+15-16*6*11*(4)*4-5+18-15*14-(9)*(14)-8-3*13*10*(2-16-19+14+18*1)-15+11*(20)+(9)+5*1+19*20+1+2*7))-(6+11)+((8*7-15*(16)+(12-12)*17+11*14*15*13-(15+18+19))*8)*5+18*((2+(14)+4*4+1-(12-16)*13-6-(10)*9*(10)+7-14-17+12-2*11-9+10*(12+6)+4+13+(10)-2-18*4+12*4+(9-10)+10+18-2+17+(6*11*17*3)-14*6+19*9-(15+12)-(17-11)*10-8-11*10+5+3-15+2*19*11*9*18*10-15+15+17*(5)-(8+1)+20-2*19*8-10-11*16*18+11*(11-14)*7+13+(3)+(1)*1+5*(11)+(14)+17*5))*9-(2)+20*1+7-(15*2)+4+(2+4)+(6)+6*13-5*(((6)*(2)))+8-6-15-2*14+8-12-7-((7-7-4))-((1)-19*19-16+18-7-1+19*3+4*12-15*((20))*11-19*20*12*9)*8-18+(11-3-(16)*(4+2))*1+(9-9-16-17*(15+4)-1)-13*20*19+9+2-3+18-5*15*(4*4)*10-(16)*10+11-14-3+3*15+(16*7)+17+8-5-8+11+17-12-13*3+17-2*12*15+20*20*12+(2)*6+(15+5)+4*2+(4)+5*17-8-12+3+4+7+17+14*20-(9)*2*5*5+18-2*1*10*20-19-(12)*13+19*16*17+2*((2-5-1+17+13+14+14+13)*9+18-4+17*7-1*13+4*10-1*15+9-18+5+18-1)-16+7+(5+10-1*15)-8*10*14-2*13*12-4+20-19+16*13+13*10-7+7+16+20*16-15-14-20*(4)*6*(8)*10+9-6*((9-12*3*5*4*7*9+10*18-18-10*11*16-10+2-19-(17)+(8-8-3+13*13)*5))-3-1*(4-14)-11+8*(11)+(19-14*8-11+17)*10+15+18*16-(1)*(8*3-(5))-((11-12)*(5)-20+13)+12*2+4-10+11-13-5*4-6+13*20+20-((10)+13-19+15+17*13+11)+13-2-(15)-10*13-18+6-10+(11+18)*18+(1)-(4-13-18*8-(5)-9*9)*2+17+8+19-2+18*(16*17)-6*3+2+1-19+4+20*11+9*18+11+(10*18)+12-15*5-13-9+20-13-16*(18-4*3+6*16+3+10+17-8*(17)+20-14*19)+11-10+13*(16)-13+4-19*4*((8)-8-10)-2-9*3+13-15+3*10+8-(14*8+13-6*18-11+20*8+8)-14*14+18-2+8-6+5*(1)+(6)*16*15-12*3-18+16*3*10+15+15+20-4*4*(15*5)+13+20-7*4*5-12*15+9-13+1*1+16*8*15+5-13-8+20*17*9-(15+9+12-6-18*15)+14*(4-8+(13)+(13-13)-8*9-17*10-(20)-3+19)*(14-11)*3*5*7-7-1+9+4-5*13+15*2+1+(18)+(14-15)+(18)+1+15+6-1-19+1*(12)-8*15-3-9+6-13*(16)-9*15+(9)+10+(19)-14+18+(14+9+13+5+10-20*4*8+15+20-9+6)*15*7-10-20-4*19+((10*18))+6-15-1+18+(3-2)+2+12+8+16*14*6*2+8+16-4-20*(3*13-17+4-5-1+7-9+12+1+(5)*13*11*15-16)*8-(2-6-6)-(11*2)+20-20+13+3*12*8+17*15-17-7*8-14-16*7-15*13+(7-10*11*18)*7*18-10+16*(10)-19+6+(13*13)-((11-19-4+14)-19*15*5*2+7*18+15*1+13+1*7+10-19*4*(14+4)*6+19-17*8*20*4-16*9-14+15+2*19-15+17*5*(15-8))+((2)-16*15-19*8+13-10+10-6*5*5+4-(10)-4-8+5-18-2*3*4*12+15-5*7+3-15*6-17+11)*((16*14)*(18)*7+20+6+4-16-18-5*20*8)+3-1+16*8+14-13-4+13-12-9-9+7-5*(18)-9+18-((1))+14-9*15*6+6*9+19+10*11-20-(6)*(15)-20-16-((3))+(8)+8*12+17-12*11-20-(5*19*14+17)*8*14-5-20+16-(14)-11+4*2*20-(17*10)-(12)+15+1-(17-20)+15+2-3*18+17-17+2*16*8-10*4+4*12*20+5-9+11+((13+19*6*5*11*19*4-11)*6)-16-((7*16*20+20*20+14-8+11*16-(5)-11*19*5*4-8*(3)*3+9+16-16-17-11-20-16+20+10*5-11*17+9+16*5-20)+9*7-3*13-16*9+11-17*3-14+6*11+18-3-(3-6+(13)-6*5*14+11)+(1+17)-(2)+2*13-14+6-13+12*18-3+12*1+17+5-6*4-19-12*8+13*(4-15)-5-1*17*14*14-17+12+(6+(8))-3)+(7-12-8+14-4-19*(2-18+1)*20-17-9+7-12*15-13+3-(15)+6-18-12*2*(5)*(6)+12+19*12*14+5-5*17*18-((4))+(7*6)*1+(5)*11*8+13*8+2+(7-6)+11+8+2*14-15-10-4*10-7-(1-13*4+4))-19*((11+20-5+10+6+14*13))-5+5*6*11+(14)*20-12-2-19+9+2*2*(7*8*2+6+14+18-4)*4-18-8+1+1+(9)+4-11+1*11+11+1-16-15+(4*16)+17*7-20+17*1+7*18-(8)-(10+11)+(7-11+2+9*3-2*4+15-1*18-20*19-20-(20+19)-(19)-1-18-4+9*10-(8+14*2-17)-(16-7+5)*17-2-7*14+((9))*16+19+1-6+(13-13)*1*6-(1*13-1*16+11+3)+8+16+((1*4)+12*20+6+13)-17*(11)-10-5+12*7*17*15-8*19*12*(14)*7*11+5-19-12-15-1+8*4-8*3*14*9-19+6-1*(12)*(7-10*6+7)*10-2+19*7-4-8+20+10*15+10-11*(5)-8*7+((8+19))+(6)+3*(10*9+19+5+(19)-6-13*9*12*7*12*(19-10)-6*19+16-10+1+10+3*4-19-2*15*(7-17))-18-(11)+11+20+3-11*17-14-(5)*16*16-13*17+7*20+20-10-8*19*15+19+8*15+9-6-7-6+18-6*3+(1)+(16)*2+13-18+13-(17)+9-1*18-6+(12)+19-14*(1)+4+2-15*5*(10)+(13+2+17-17+((18)))*(14-16*9+13)+11+8-17+8*6-2+19*11+12*5*18-12*16-14-20*2+7-8*16+9+1+8*10*6+11-4*10+(9+3)-8+6-14*19+8-(5+11-6+16+12*(1)+8-19*17-8+18*14*2)-(17-12-5+2+4-15+7-12+(8)+19+1+16+3*20*7*1-3-2+8*16*3-20-(5*17))*5*19+1+2*(3)-17*19-13*18*(20)+(2+1)+6*1+((1))-(6+14+(2))-(2+9)+(6)+20-15+12-5+18*16-17+12-(1)+19+3+12*12*5+((20)-19-16)*16*7*7-(5-3)+3-5)+(15)+19*14+13*(14)*18+11-10-20-9-3*20+16-6*18*3*14-(12)+7-6+10*18*3-10-((4)-20-15*8*12+17*13)*(6)-7-6*9+1+15-20-4*8*19+19-12-9+4+11-7-(1)+1+19*4+2-5+3+17-(15)-20-17+7+8-16-15*9*8*6-((5)+13*12)-18+10*16*7*9*8-18-16*(14*4-11+15)-7-(16-4)*16-19+6+5+13+(15+4)-((12))-8-9+6-2-5+1*12+(14)+19+8+13+20-11+5-17-8-(19)+2+5-8*4-19-3-8-1*13+3-(15)-19*4*16*(9)*20-6*10+17-(6-5)-4*2+5+19*7*(18-15-5*10-11-16+(8))+8+10*6*(17*1)-(13)-16-(15*6)+4-20*4*16+19+14-20-9*15-8*(2*1*20)-(7-14)+4*2+15-3+(20*9*18-17-3+7+4)*(7)*2-17+19-6-7+(4)-(14)*(15+16-9-20+6*13-20*14)+(16+(7)*3-12+15+4*1-6-(5)+2*12*13+9*4+20*16-6*12*14-10-6*(12)*4-2*18+16+20+15-15-(17-6*(16))+13+7*17*4+20*15+7*9*14-16+12+3-6-6+20-10-(7)+16+(14)*15*4-14+13+9-4+13*11-14+9+17*(14)-4+3-9+18*3+18+1-7+19-13)+((13*20+5*2)-3*10-7*7+(1-13))+5-1+8+1+7*20+10*3-18*3*1+2-5-(10)-17*12+12*6+17*9-18-20-18+13*5*8+16-1+(6)+14*17+15-1*(10)+7+3*19-19+7+20*(19*16-20+8*12+6+6)+(16-6+6*19-(14)*15+3)-(15-15+10*(19))*(7+11)-10+8*4+18-10-19*8+10-10*12+4*6+13*11*18+20*(18)*16-11-(8*6+(11)-(18)*1*10)*8+15*8-17+(9-(8)+2+10-3*19*(3+5*14*5)+11*(14-16+(12))*((7-12*8))+1*20-19*8-10*1*3*16*7+8*(11*6)-(18-6-19-17*20*16-(19))-(19)-2+7-1-8+2*8*(12+3*(16))-(11*4)-4-13+5-15+15*19-(1)+12+5-9-16*7-3+8*12-15-6-15*(15)+3-13+5*9-15)-19+10*((12))+((16-7-14-(4)-(8)-(7-17)-4-19+10+7+(1+7*9+14)*5-10+2-19*15*18+((11-(11))-8+(11+12-6-4-16)))-13+4+8*11*20+18*7-12*8+18*6-16*13-18+(9*9*12-17*13-20-10)+13*9*7*4*8-20*(14)+5-13-15+15+6-4+12-2*7+1*10-1+13+18+14*12+15+18*2+4+3-11+20-19+2*17+20+10+15*14*13-6-18*1+12-(18)-11+12*20*13+3-6+(4)-(9)-10+15+(8)-11+4-8-20-(18-1-(6))+10+19*(17)-14+(9+15*4+18-17*13+5*8-2*20+(17)*(14*2)-14+16*5+3+8-(2)+11-16+20+5)+(16+(16)*(18)*20+9*6-((4))*20*5-20+13-15-2-2+13*19-9-10-13-2-1*8*9+17+(18-5+(16))*18+2-6+7*14+6-7-15+9+11-6*6-9-16*5-11*(7*20)*11-17-6+20+14+19+10*13+9+3-(15)-((5)+11+4)*9-7+18+10+4-1-7-8*19*2-4*1+3+15-(1)+16+1-6-15*9*6*15-18-((10))-10-(11)*12*5*9*14+3+20-(1-(20))+12+(10)-1-2-7+20+19+17*20+(((4)*1+18))-5+8*18-10+3*18-6*10-13*8*19*((6))*10+(7+12)+(12+18*17+10+15+10-5+20*4+6-3+19)-(12*19)))\n", result => '83292371', out => \&check_rpn }, { in => ("(" x 2499)."2".(")" x 2498)."*". ("(" x 2498)."3".(")" x 2499)."\n", result => '6', out => \&check_rpn }, { in => ("1*" x 4999)."2\n", result => '2', out => \&check_rpn }, ] } ], }; sub check_result { my ($expr, $expect) = @_; my @stack = (); for ($expr =~ /\S+/g) { if (/-?\d+/) { push @stack, $_; next; } my $a = pop @stack; my $b = pop @stack; if (!defined $a || !defined $b) { die "Stack underflow\n"; } if (/\+/) { push @stack, $a + $b; } elsif (/\-/) { push @stack, $b - $a; } elsif (/\*/) { push @stack, $a * $b; } elsif (m|/|) { push @stack, int $b / $a; } else { # Shouldn't happen die "Invalid token: $_\n"; } } if (!@stack) { die "Stack is empty after evaluation\n"; } if (@stack != 1) { die "Stack contains more than one element after evaluation: << @stack >>\n"; } my $result = pop @stack; if ($expect != $result) { die "Invalid result after evaluation: got '$result', expected '$expect'\n"; } } sub check_newline { die "Result contains multiple newlines\n" if $_[0] =~ /\n.*\n/; die "Result not properly newline-terminated\n" unless $_[0] =~ /\n\z/; } sub check_parts { my ($data, $input) = @_; my (%d, %i, %b); # Check that output contains only numbers and valid operators if ($data =~ m|([^\s\d+/*-])|) { die "Invalid token '$1'\n"; } my $re = qr{\d+|\+|\-|\*|/}; # Strip leading zeros from both input and output $data =~ s/0*(\d)/$1/g; $input =~ s/0*(\d)/$1/g; # -0 == 0 $data =~ s/-0+\b/0/g; $input =~ s!([*/+-]|^)\s*-\s*0+\b!$1 0!g; $d{$_}++, $b{$_}++ for $data =~ /$re/g; $i{$_}++, $b{$_}++ for $input =~ /$re/g; for (keys %b) { $d{$_} += 0; $i{$_} += 0; if ($d{$_} != $i{$_}) { die "Invalid amount of '$_' tokens: got $d{$_}, expected $i{$_}\n"; } } } sub check_whitespace { my $data = shift; die "More than one consecutive whitespace characters\n" if $data =~ /\s\s/; die "Trailing whitespace\n" if $data =~ /\s$/; die "Leading whitespace\n" if $data =~ /^\s/; } sub check_rpn { my %test = %{ +shift }; my $data = shift; eval { check_newline $data; chop $data; check_whitespace $data; check_parts $data, $test{in}; check_result $data, $test{result}; }; if ($@) { die "$@". "Input:\n$test{in}". "Output:\n$data\n"; } } # CODE START # Don't remove this comment block # You normally shouldn't change anything below this point. # Code part (*not* the hole data) copyright by Ton Hospel # This file is made freely available under the same conditions as perl, # GPL or artistic license, your choice. # The latest skeleton can always be found at # http://www.xs4all.nl/~thospel/golf/gentest.pl my $VERSION = "0.09"; # use Data::Dumper; $Data::Dumper::Indent = 1; use Errno; use Fcntl; use Getopt::Long; Getopt::Long::config("bundling", "require_order"); my $FILE_VERSION = 2; my $DEFAULT_TIE_DIGITS = 2; my $INVALID = qq([\t\r\n\0=\\\'\"]); # " (silly emacs) my ($unsafe, $help, $version, $verbose, $list, $binary, $markers,$force); my (@files, @missing, $failed, $sum, %props, %programs, $missing, $ties); my ($norun, $data_file, $full, $brief, $nr_ties, $quiet, $dump, $save, $exit); my ($single, $driver, $nop, $tie_digits, $pod, $debug, $fetch, $in_open); my $marker = "|"; my $executor = "/usr/bin/env"; my $generic_name = "gentest.pl"; my $generic = $0 =~ /\b\Q$generic_name\E\z/; restore(shift) if $generic && @ARGV && $ARGV[0] !~ /^-/; die "Could not parse your command line\n" unless GetOptions("unsafe!" => \$unsafe, "U" => \$unsafe, "help!" => \$help, "h" => \$help, "version!" => \$version, "verbose!" => \$verbose, "v" => \$verbose, # "markers!" => \$markers, # "m" => \$markers, "binary!" => \$binary, "b" => \$binary, "data_file=s" => \$data_file, "force!" => \$force, "tie_digits=i" => \$tie_digits, "program=s" => \%programs, "p=s" => \%programs, "quiet!" => \$quiet, "full!" => \$full, "brief!" => \$brief, "list!" => \$list, "l" => \$list, "n" => \$norun, "no_checks!" => \$norun, "dump=s" => \$dump, "save=s" => \$save, "single=s" => \$single, "driver=s" => \$driver, "pod=s" => \$pod, "fetch=s" => \$fetch, "nop!" => \$nop, "debug!" => \$debug, ); if ($version) { print<<"EOF"; test data set version $::tests->{version} generic perl golf tester version $VERSION EOF $exit = 1; } if ($help) { require Config; $ENV{PATH} .= ":" unless $ENV{PATH} eq ""; $ENV{PATH} = "$ENV{PATH}$Config::Config{'installscript'}"; if (0) { # scanning the file is very slow exec("perldoc", "-F", $unsafe ? "-U" : (), $0) || exit 1; # make parser happy %Config::Config = (); } else { my $file = $0; $file =~ s/\.pl\z//i; $file .= ".pod.$$"; save($file, 4); system("perldoc", "-F", $unsafe ? "-U" : (), $file); unlink($file); $exit = 1; } } my %set_map = (brief => -1, normal => 0, full => 1); die "Can't specifiy both --full and --brief\n" if $brief && $full; my $do_set = $set_map{normal}; $do_set = $set_map{brief} if $brief; $do_set = $set_map{full} if $full; restore($data_file) if !$generic && defined($data_file); data_check(); if (defined($dump)) { save($dump, 0); $exit = 1; } if (defined($save)) { save($save, 1); $exit = 1; } if (defined($single)) { save($single, 2); $exit = 1; } if (defined($driver)) { save($driver, 3); $exit = 1; } if (defined($pod)) { save($pod, 4); $exit = 1; } if ($list) { my $i; print "$0\n" if $debug; print "Course $::tests->{course}\n\n" if defined($::tests->{course}); for my $test (@{$::tests->{holes}}) { printf "Hole %2d: %s\n", ++$i, $test->{name}; } $exit = 1; } if ($fetch) { fetch_file($fetch, "$::tests->{base_url}/fun.txt"); $exit = 1; } exit 0 if $exit || $nop; sub new_file(*$;$) { my ($fh, $file, $mode) = @_; $mode = 0666 unless defined($mode); # avoid perlio bug where perl tries to warn that you open fd 0 # for write, sending this directly to fd 2, which causes a coredump if # that is closed local $^W = 0; sysopen($fh, $file, O_CREAT | O_WRONLY | O_EXCL, $mode) || die "Could not open $file for create: $!"; } sub lines { return [map"$_\n",@_]; } sub high_ascii { my ($code, $score) = @_; my $tie = 0; for ($code =~ /./sg) { $tie += ord if 127 > ord; } # tie is really $tie/=length($code)*126, but expand the middle to # make the normal range more distinctive. map [0,1] to [-1,1] and # take the cube root $tie = 1-$tie/($score||1)/63; if ($tie < 0) { $tie = -((-$tie)**(1/3)); } else { $tie = $tie**(1/3); } # Now recover [0,1] and map to [0, 0.99] so that the tie # can never change the main score return ($tie+1)*0.495/$nr_ties; } sub min { $_[0] < $_[1] ? $_[0] : $_[1] } sub trp05 { my ($code, $score) = @_; my $lines = 1 + $code =~ y/\n//; # Start with average line length my $tie = $score / $lines; # Scale it from 0.5 to 1, with anything over 80 being a 1 $tie = 0.5 + min($tie, 80)/80/2; my $right_chars = $code =~ y|0-9 \t*/+()-||; # Decrement with the ratio of good characters in the code $tie -= $right_chars/$score; $tie = .99 if $tie > .99; # I doubt that anyone besides Andre Savigne will manage to # trigger this. $tie = .01 if $tie < .01; return $tie } my %tie_map = (high_ascii => \&high_ascii, trp05 => \&trp05); # Quick sanity check on $::tests fields sub data_check { $::tests->{version} = 0 unless defined $::tests->{version}; die "version should be a natural number, not '$::tests->{version}'\n" unless $::tests->{version} =~ /^\d+\z/; $::tests->{holes} = [] unless $::tests->{holes}; die "Course name '$::tests->{course}' contains invalid characters like '$1'\n" if defined($::tests->{course}) && $::tests->{course} =~ /($INVALID)/; for my $hole_data (@{$::tests->{holes}}) { $hole_data->{name} = "hole" unless defined($hole_data->{name}); die sprintf("Hole name '%s' contains invalid characters like ". "'%s'(0x%02x)\n", $hole_data->{name}, $1, ord($1)) if $hole_data->{name} =~ /($INVALID|\s)/; $hole_data->{program} = "$hole_data->{name}.pl" unless defined($hole_data->{program}); die sprintf("Hole program '%s' contains invalid characters like ". "'%s'(0x%02x)\n", $hole_data->{program}, $1, ord($1)) if $hole_data->{program} =~ /($INVALID|\s)/; } } sub restore { my $file = shift; local (*FILE, $_); open(FILE, "< $file") || die "Could not open $file for read: $!"; defined($_ = ) || die "$file seems empty\n"; if (my ($arg) = /^\#! ?\S*perl\S*\s+(\S+)\s*$/) { # seems pure perl code my $rc = system("./$file", "--nop"); die "Unexpected returncode $rc from ./$file --nop\n" if $rc; } elsif (/^=/) { # smells like pod # no sane pod checks currently } else { # Storable dump or Data:Dumper defined($_ = ) || die "Unexpected short EOF from $file\n"; if (my ($file_version) = /^file_version=(\d+)/) { die "$0 is designed for dump file version $FILE_VERSION, but '$file' is version $file_version\n" if $file_version != $FILE_VERSION; require Storable; while () { last unless /\S/; } $::tests = Storable::fd_retrieve(*FILE); defined($_ = ) || die "$file seems truncated\n"; $_ eq "\n" || die "$file seems damaged\n"; defined($_ = ) || die "$file seems truncated\n"; $_ eq "# end\n" || die "$file seems damaged\n"; } else { require $file; } } } sub save { my ($file, $pretty) = @_; my $new = "$file.new.$$"; local *FILE; new_file(local *FILE, $new, 0777); binmode FILE; eval { if ($pretty) { unless ($pretty == 4) { require Data::Dumper; $Data::Dumper::Indent = 1; if ($pretty > 1) { print FILE "#! /usr/bin/perl -w\n"; } else { print FILE "#! $executor $generic_name\n"; } if ($pretty == 3) { print FILE <<'EOF'; use strict; $::tests = { version => 1, holes => [ # hole definitions and tests go here ], }; EOF ; } else { print FILE <<'EOF'; use strict; use vars qw($VAR1); $::tests = EOF ; print FILE Data::Dumper::Dumper($::tests); } } if ($pretty > 1) { local (*CODE, $_); open(CODE, "< $0") || die "Could not open $0 for read: $!"; binmode CODE; my $magic = $pretty == 4 ? "__END__" : "# CODE START"; while () { last if /^\Q$magic\E\s*$/; } die "Could not find magic marker '$magic' in $0\n" unless defined($_); if ($pretty == 4) { while() { last if /^=/; } die "Could not find actual pod in $0\n" unless defined($_); } else { print FILE "\n"; } print FILE; my $last = $_; while () { print FILE; $last = $_; } if ($last ne "=cut\n") { print FILE "\n" if $last ne "\n"; print FILE "=cut\n"; } } } else { require Storable; # file_version must be first ! print FILE <<"EOF"; #! $executor $generic_name file_version=$FILE_VERSION data_version=$::tests->{version} program_version=$VERSION EOF ; print FILE "course=$::tests->{course}\n" if defined($::tests->{course}); print FILE "hole=$_->{name}\n" for @{$::tests->{holes}}; print FILE "\n"; &Storable::nstore_fd($::tests, *FILE); } print FILE "\n# end\n" unless $pretty > 1; close FILE; restore($new); rename($new, $file) || die "Could not rename $new to $file: $!"; }; if ($@) { unlink($new); die $@; } } sub fetch_file { my ($file, $url) = @_; require LWP::UserAgent; my $ua = LWP::UserAgent->new; $ua->env_proxy; $ua->agent("gentest.pl/$VERSION " . $ua->agent); my $request = HTTP::Request->new(GET => $url); my $res = $ua->request($request); $res->is_success || die("Could not fetch '$url': ", $res->status_line, "\n"); my $new = "$file.new.$$"; new_file(local *FILE, $new); eval { binmode FILE; print FILE $res->content; close FILE; local $/; open(FILE, "< $file") || die "Could not open '$file': $!"; binmode FILE; my $line = ; $line eq $res->content || die "'$file' doesn't contain what just got written. Disk full ?\n"; rename($new, $file) || die "Could not rename $new to $file: $!"; }; if ($@) { unlink($new); die $@; } } sub permutations { return [] unless @_; return map { my $elem = $_; map [$elem, @$_], permutations(grep {$elem ne $_} @_); } @_; } sub count { my ($hole, $tie) = @_; my $file = $props{$hole}{work}; local (*FILE, $/); open(FILE, "< $file") || die "Could not open $file: $!\n"; binmode FILE if $binary; defined(local $_=) || return 0; if (/^\#!/) { s/\#! ?\S+//; s/\n//; } s/\s*\z//; my $score = length; if (defined($tie)) { defined(my $code = $tie_map{lc($tie)}) || die "Unknown tie function $tie\n"; $score += $code->($_, $score); $ties++; } return $score; } sub compare { my ($context, $file, $txt, $newline, $test_data) = @_; open(local *FILE, "< $file") || die "Could not open $file: $!"; my $all = ; $all = "" unless defined($all); my $ref = ref($txt); if ($ref eq 'CODE') { return $txt->($test_data, $all); } elsif ($ref eq 'ARRAY') { $txt = join("", @$txt) if ref($txt); } elsif ($ref) { die "Invalid reference type: ", $ref, "\n"; } $txt .= "\n" if $newline; if ($txt ne $all) { $all =~ s/(?=\n)/$marker/g if $markers; $all =~ s/\n?\z//; $txt =~ s/(?=\n)/$marker/g if $markers; $txt =~ s/\n?\z//; die "Unexpected $context: Expected:\n$txt\nbut got:\n$all\n"; } } # Must be called with STDOUT and STDERR closed. Will (again) be closed at exit. # STDIN may be open (indicated by $in_open), and may be closed or open at exit, # again indicated by $in_open sub check_single { my ($hole_data, $nr, $test) = @_; my $hole = $hole_data->{name}; my $set = $hole_data->{set}; if (defined($test->{set})) { defined($set = $set_map{lc($test->{set})}) || die "Hole $hole, test $nr: Unknown set type $test->{set}\n"; } return if $set > $do_set; my $name = $test->{name}; my $in_file = "$hole.in.$$"; my $out_file = "$hole.out.$$"; my $err_file = "$hole.err.$$"; my (@perms, $shown); if ($nr == 1) { if (my $perm = $hole_data->{permuted_args}) { @perms = permutations(@$perm); $hole_data->{perm} = pop @perms; } } RETRY: my $args = $test->{args}; $args = "" unless defined($args); $args = [split " ", $args] if !ref($args); if ($hole_data->{perm}) { my @args = @$args; @args[@{$hole_data->{perm}}] = @args[@{$hole_data->{permuted_args}}]; $args = \@args; } eval { # $SIG{HUP} = $SIG{INT} = $SIG{QUIT} = $SIG{TERM} = sub { die "Argh. Killed by signal\n"; }; local $/; if (defined(my $in = $test->{in})) { $in = join("", @$in) if ref($in); if ($in_open) { close STDIN; $in_open = 0; } new_file(local *FILE, $in_file); print FILE $in; close FILE; open(FILE, "< $in_file") || die "Could not open $in_file: $!\n"; my $all = ; $all = "" if !defined($all); die "unexpected short read from $in_file. Disk full ?\n" if $in ne $all; close FILE; open(STDIN, "< $in_file") || die "Could not open $in_file: $!\n"; } elsif (!$in_open) { # we need a placeholder so that a later dup to STDOUT/STDERR # will not end on fd 0 open(STDIN, "<&IN") || die "Could not restore STDIN: $!"; } $in_open = 1; new_file(*STDOUT, $out_file); new_file(*STDERR, $err_file); if (defined($name) && $name ne "") { $name = sprintf("%2d (%s)", $_, $name); } else { $name = sprintf("%2d", $_); } my $file = $props{$hole}{file}; printf ERR " %s: Running test %s ... ", $file, $name unless $quiet || $shown++; # print ERR "$^X, $props{$hole}{work}, @$args\n"; my $rc = system($^X, $props{$hole}{work}, @$args); print ERR "Program $file dumped core\n" if ($rc & 0x80) && !$quiet; die "Program $file killed by signal (", ($rc & 0x7f),")\n" if $rc & 0x7f; $rc = $rc >> 8; if (defined(my $exit = $test->{exit})) { if (my ($val) = $exit =~ /^!(.*)$/) { die "Program '$file' should not finish with exitcode $rc\n" if $val == $rc; } else { die "Program '$file' should finish with exitcode $exit, not $rc\n" if $exit != $rc; } } if (defined(my $err = exists($test->{err}) ? $test->{err} : "")) { compare("STDERR", $err_file, $err); } if (defined(my $out = $test->{out})) { compare("STDOUT", $out_file, $out, $hole_data->{newline}, $test); } }; close STDERR; close STDOUT; unlink($out_file, $err_file); if (defined($test->{in})) { close STDIN; $in_open = 0; unlink($in_file); } if ($@) { unless ($@ =~ /killed by signal/i) { if ($nr == 1 && $hole_data->{perm} && @perms) { $hole_data->{perm} = pop @perms; goto RETRY; } } $failed = 1; push(@{$props{$hole}{failed}}, $nr); if (@$args) { if ($nr == 1 && $hole_data->{perm}) { $@ = "(args: @$args (I also tried all other valid permutations, but none of them gave the expected output)) $@"; } else { $@ = "(args: @$args) $@"; } } unless ($force) { print ERR "Failed test $nr" if $quiet; die $@; } print ERR $@ unless $quiet; } else { print ERR "Ok\n" unless $quiet; } } sub copy { my $hole_data = shift; my $hole = $hole_data->{name}; $props{$hole}{work} = my $new = "$hole.$$"; my $file = delete $programs{$hole}; $file = $hole_data->{program} unless defined($file); $props{$hole}{file} = $file; local (*I, $_); unless (open(I, "< $file")) { die "Could not open $file: $!" unless $!{ENOENT}; $props{$hole}{missing} = 1; return 0; } binmode(I); new_file(local *O, $new); binmode(O); print O while ; return 1; } sub check_hole { my $hole_data = shift; my $hole = $hole_data->{name}; my $test = $hole_data->{check}; print ERR "Checking hole '$hole'", $quiet ? "..." : "\n" unless $norun; die "Already tested $hole\n" if exists $props{$hole}; if (copy($hole_data)) { push(@files, $hole); $sum += $props{$hole}{count} = count($hole, $hole_data->{tie}); unless ($norun) { eval { close STDOUT; close STDERR; check_single($hole_data, $_, $test->[$_-1]) for 1..@$test; }; if ($in_open) { close STDIN; $in_open = 0; } open(STDIN, "<&IN") || die "Could not restore STDIN: $!"; $in_open = 1; open(STDOUT, ">&OUT") || die "Could not restore STDOUT: $!"; open(STDERR, ">&ERR") || die "Could not restore STDERR: $!"; die $@ if $@; } } else { push(@missing, $hole); print OUT " File $props{$hole}{file} does not (yet) exist. Skipping it\n"; $missing = 1; } print ERR !$quiet ? "" : $props{$hole}{failed} ? "Failed test $props{$hole}{failed}[0]" : "Ok", "\n" unless $norun; } { my %abbrev; sub build_abbrevs { for (@{$::tests->{holes}}) { my $hole = lc($_->{name}); do { push(@{$abbrev{$hole}}, $_->{name}); chop $hole; } while $hole ne ""; } return \%abbrev; } sub lookup_abbrev { my $name = shift; defined(my $targets = $abbrev{lc $name}) || die "Never heard of hole '$name'\n"; die("Multiple matches for '$name': ", join(", ", @$targets), "\n") if @$targets > 1; return $targets->[0]; } } sub show_holes { my (%work_programs, %holes); my $abbrev = build_abbrevs; $work_programs{lookup_abbrev($_)} = $programs{$_} for keys %programs; %programs = %work_programs; for (@{$::tests->{holes}}) { my $hole = lc($_->{name}); die "Multiple holes named $hole\n" if $holes{$hole}; $holes{$hole} = $_; $nr_ties++ if $_->{tie}; if ($_->{set}) { defined(my $set = $set_map{lc($_->{set})}) || die "Unknown set type $_->{set} for hole $hole\n"; $_->{set} = $set; } else { $_->{set} = -1; # default is brief } } my @to_test; if (@_) { @to_test = map {$holes{lookup_abbrev($_)} || die "Never heard of hole $_\n"} @_; } else { @to_test = @{$::tests->{holes}}; } if (!$quiet && $::tests->{perl}) { my ($main, $sub, $rel) = $::tests->{perl} =~ /^(\d+)\.(\d+)\.(\d+)$/ or die "Could not parse wanted perl version $::tests->{perl}\n"; my ($Main, $Sub, $Rel) = $] =~ /^(\d+)\.(\d{1,3})(\d*)$/ or die "Could not parse running perl version $]\n"; $Main+=0; $Sub +=0; $Rel = $Rel ? $Rel+0 : 0; print ERR "Warning: Using perl version $Main.$Sub.$Rel, not the preferred $::tests->{perl}\n" if $Main != $main || $Sub != $sub || $Rel != $rel; } eval { check_hole($_) for @to_test; }; print ERR "\n" if $quiet && !$norun; unlink($props{$_}{work}) for @files; die $@ if $@; if (@files) { my $header = "total"; if ($ties) { if (!defined($tie_digits)) { $tie_digits = $DEFAULT_TIE_DIGITS unless defined($tie_digits = $::tests->{tie_digits}); } } else { $tie_digits = 0; } $sum = sprintf("%.*f", $tie_digits, $sum); my $count_length = length($sum); my $name_length = length($header); for my $hole (@files) { next if $props{$hole}{missing}; $name_length = length($props{$hole}{file}) if length($props{$hole}{file}) > $name_length; } for my $hole (@files) { next if $props{$hole}{missing}; printf OUT ("%-*s %*s strokes %s\n", $name_length+1, "$props{$hole}{file}:", $count_length, sprintf("%.*f", $tie_digits, $props{$hole}{count}), $norun ? "" : $props{$hole}{failed} ? "(fail)" : "(ok)" ); } if (@files > 1) { printf OUT ("%*s %s\n%-*s %*s strokes\n", $name_length+1, "", "-" x $count_length, $name_length+1, "$header:", $count_length, $sum); } } if (@missing) { print OUT "You are still missing programs for: ", join(", ", @missing), "\n"; } elsif (!$norun && @to_test == @{$::tests->{holes}}) { if ($failed) { print OUT "Some more work is needed to pass all tests\n"; } else { print OUT "Congratulations ! All tests passed for all holes\n"; } } } local *IN; open(IN, "<&STDIN") || die "Could not dup STDIN: $!"; open(local *OUT, ">&STDOUT") || die "Could not dup STDOUT: $!"; open(local *ERR, ">&STDERR") || die "Could not dup STDERR: $!"; { my $fh = select(ERR); $|=1; select($fh); } $in_open = 1; eval { show_holes(@ARGV); }; if ($@) { print ERR $@; exit 1; } __END__ =head1 NAME gentest.pl - Generic perl golf tester =head1 SYNOPSIS gentest.pl gentest.pl [-b] [-m] [--tie_digits=num] {-phole=file} [--force] [--full | --brief] [-n] {hole} gentest.pl -l gentest.pl --data_file data_file gentest.pl [-U] [-h] gentest.pl --version gentest.pl [--dump file] [--save file] [--single file] [--driver file] [--pod file] gentest.pl --nop =head1 DESCRIPTION Use B to check perlgolf solutions. By default it will try to run all defined standard tests for all holes, score the holes and give you a grand total. By giving hole names as arguments you can restrict the program to only a given set of holes. In all places where you enter hole names, it's enough to specify enough of the start letters to uniquely identify the hole. The tests will be run using the same perl version that is running the script itself. So you can use an alternative interpreter by doing other_perl gentest.pl Some more obscure options are described below. =head1 OPTIONS =over 4 =item -l, --list List the holes in this course. =item --program hole=file =item -p hole=file Runs a non-standard file for a given hole. E.g. if there is a hole named "maze", the tester will normaly run F. By giving the option C<-p maze=foo.py>, it will run F instead. =item -n, --no_checks Just score the programs, don't run the checking code. =item -b, --binary Do the bytecounting of the files in binary. Strictly speaking on windows you should remove the carriage return just before the linefeed and do the test using this option. This is awkward, and usually there will be no difference. But it will if you have B carriage returns before the newline. =item --quiet Be less verbose. In particular, don't tell about each single test being done. =item --full Use a more extended test-set (if one is defined). =item --brief Use a restricted test-set (if one is defined). =item --force Keep running even after errors. =item --tie_digits=num Show num digits of the tiebreaker score (default 4). =item --data_file data_file Use the given external file as dataset. If not given, the data is assumed to be inline in the program. A special case is if the program is called F. Then the first argument is assumed to be the name of the datafile. =item -h, --help This help. =item -U, --unsafe Allows you to run this help as root. However, L is not designed to run as root, and you will also be calling several external programs as root. Avoid it. =item --version Show the version number of this program and of the dataset. =item --dump file Writes a standalone dataset to the given file. Needs L. Guaranteed not to execute foreign code on load. The file will start with #! /usr/bin/env gentest.pl so if you want to be able to run it from the commandline, gentest.pl should be in your PATH. Notice that the file format has not stabilized yet, so backward and forward compatibility is currently not guaranteed. =item --save file Writes a standalone dataset as perl code to the given file. The file will start with #! /usr/bin/env gentest.pl so if you want to be able to run it from the commandline, gentest.pl should be in your PATH. Notice that the file format has not stabilized yet, so backward and forward compatibility is currently not guaranteed. =item --single file Writes a standalone dataset as perl code followed by gentest.pl to the given file. You can distribute this and won't need anything external (except perl itself). =item --driver file Writes only the generic driver program to the given file. Should normally be called F. These last options can be combined in several ways. E.g. suppose you have an old (or untrusted) standalone testprogram F and a new (or trusted) standalone testprogram F and now want to have a standalone version of the old data with the new code. You can do that by using (assuming . is in the PATH): other.pl --driver gentest.pl # New standalone program data.pl --dump old_data # dump the old data gentest.pl old_data --single mix.pl # Generate the new program (if data.pl is untrusted you must run it in some kind of jail. The load phase itself however is secure if you use the L<--dump|--dump> format to move the data) =item --pod file Writes the pod documentation to the given file. You can then run that as perldoc -F file and get the same result as from directly using the --help option. =item --nop Don't do anything. This is used internally to test a generated single file. =back =head1 DATA FORMAT At the top of the file there is a global variable named C<$::tests>. This is where holes and their tests get declared. Suppose you have two holes, one (let's call it arginc) that expects a commandline argument and should print that value followed by a newline to STDOUT and one (let's call it filterinc) that reads lines from STDIN and prints to STDOUT what it reads plus one, each time followed by a newline. An almost minimal datstructure would be: $::tests = { version => 1, holes => [ {hole => "arginc", check => [{args => 4, out => "5\n"} {args => 0, out => "1\n"} {args => -1, out => "0\n"} {args => -8, out => "-7\n"}]}, {hole => "filterinc", check => [{in => "4\n0\n-1\n-8\n", out => "5\n1\n0\n-7\n"} {in => "", out => "" }]}, ], } though even this can be simplified, for example by using the L key. $::tests is a hash reference whose keys can be: =over 4 =item version Gives the dataset version. Users will use this to see if their testset is up to date or not. Defaults to 0, but you should really specify it. =item course An optional field giving the global name of this course. Should not contain C<\n> or C<=>. =item perl An optional field giving the official perl version for this course. If given, the program will warn if the tests are done using a different perl version. The value is of the form major.minor.sub. Example: $::tests => { ... perl => "5.6.1", ... } =item tie_digits Optional field describing the number of significant digits shown for the tie-breaker. Defaults to 2 and can be overridden from the command line. =item holes An array reference with each element being a hash reference describing per hole data. The per hole hash keys are: =over 8 =item name The name of this hole. Should not contain [\s='"\0]. Defaults to "hole". =item program The default name for the user program that will try to solve this hole. Should not contain [\s='"\0]. The user can always override this using L<--prog|--prog>. Defaults to the hole name with C<.pl> appended. =item newline Normally you want the output of a hole to be properly newline terminated, and every L entry in the testset will end on a newline. By giving this key a true value, the test program will add a newline to every L entry, which makes the testset much more readable. E.g. in the "arginc" example the hole definition becomes: ... {hole => "arginc", newline => 1, check => [{args => 4, out => 5} {args => 0, out => 1} {args => -1, out => 0} {args => -8, out => -7}]}, ... =item set The test program can be started with as extra options L<--brief|--brief> or L<--full|--full>, or with neither of them ("normal"). Every test case itself is in set "brief", "normal" or "full". If the program is started with --brief, only tests in set "brief" will run. If the program is started without --brief or --full, tests in set "brief" or "normal" will run. If the option --full is given, all tests will run, regardless of their set. Every test case defaults to "brief". You can override this per test case. However, this is awkward if you want to change most of them. In that case you can use the per hole "set" key to change the default to a value of "brief", "normal" or "full". Suppose for example that for hole "arginc" you want to only run the zero to 1 case by default, and only run the rest if the user gives --full. In that case you want all holes with one exception to be in set "full", so its convenient to make that the default and only mark the exceptions: ... {hole => "arginc", set => "full", check => [{args => 4, out => "5\n"} {args => 0, out => "1\n"} {args => -1, out => "0\n", set => "brief"} {args => -8, out => "-7\n"}]}, ... =item permuted_args Sometimes it happens that a hole is defined with something like "you may give the two commandline arguments in any order, as long as the order is consistent". In these cases the test program must figure out for itself which order the user has chosen. You do that by giving this key with as value an array reference telling which arguments may be permuted (starting to count from zero). So for the example we are talking about arguments 0 and 1, so the entry becomes: ... {hole => "ambiguous", permuted_args => [0, 1], ... } ... It works by trying all possible permutations on the first test being run, until it meets one that works. The last one that will be tried is the unpermuted order, and if that one fails too, the error for B that one will be reported. If any order B work, that particular permutation is remembered and applied on all other tests, without any more searching. Notice that it's up to you to make sure the first test is able to distinguish between good and bad permutations. Especially when you use the L key to classify tests it's up to you to make sure that the first test being run (which can be different depending on if the user gives L<--brief|--brief>, L<--full|--full> or none of these) does the right thing. =item tie If given, it's the name of the tie breaker for this hole. This will be a key into a dispatch table mapping names to tie breaker code. This code, when given program text and a score (length) as arguments, will calculate a number (normally in the range [0..0.99] so it won't change the integer part of the total score) that will be divided by the total number of tiebreakers defined for the course and added to the hole score. Currently the builtin tie breakers are: =over 12 =item high_ascii =back =item check An array reference where the elements describe the actual tests that can be done for a hole. Each element is a hash reference describing one test using the following keys: =over 12 =item args The command line arguments that will be given to the program. Can be a string if there is only one argument or an array reference whose elements correspond to the arguments that will be passed. If not given, assumes no commandline arguments. If given as a string, the tester will use @args = split " ", $string; to construct the individual arguments. So use the array reference form if you want to do special things like including a space in an argument. =item in What will be passed to the program on STDIN. Can be a string or an array reference (elements will be concatenated in that case). If not given, no STDIN assumptions will be made. =item out Can be a string or an array reference (elements will be concatenated in that case). After the test has finished, the program output is compared to this string and the test fails if they are not equal. If this item is not given, no output check will be done, so you almost certainly want to specify this. =item err Can be a string or an array reference (elements will be concatenated in that case). After the test has finished, the program's STDERR output is compared to this string and the test fails if they are not equal. Defaults to the empty string, meaning that nothing should appear on STDERR. When set to C, STDERR output will be ignored. =item exit By default the return code of the program will be ignored. By defining a value for this key, you ask for a specific returncode. Preceding the value by C will demand that the returncode is B that value. =item set The concept is explained under the entry for the perl hole L key. This per test key allows you to mark exceptions to the default. =back =back =back A number of convenience functions is available to clean up the format. =over 4 =item lines This function adds a newline to the end of every argument and then joins them into a big string. So you can also write the "filterinc" hole like this: ... {hole => "filterinc", check => [{in => lines(4,0,-1,-8), out => lines(5,1,0,-7)} {in => "", out => "" }]}, ... notice that you can also use the plain perl EOF construct, for example: ... {hole => "filterinc", check => [{in => <<'EOF', out => <<'EOF'} 4 0 -1 8 EOF 5 1 0 -7 EOF {in => "", out => "" }]}, ... =back =head1 BUGS None known. =head1 AUTHOR Ton Hospel (gentest@ton.iguana.be) =cut