testc.sh 21 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631
  1. #!/bin/bash
  2. # t/testc.sh -c -Du,-q -B static 2>&1 |tee c.log|grep FAIL
  3. # for p in 5.6.2 5.8.8-nt 5.8.9d 5.10.1d 5.10.1d-nt 5.11.2d 5.11.2d-nt; do make -s clean; echo perl$p; perl$p Makefile.PL; t/testc.sh -q -O0 31; done
  4. # quiet c only: t/testc.sh -q -O0
  5. function help {
  6. echo "t/testc.sh [OPTIONS] [1-$ntests]"
  7. echo " -D<debugflags> for O=C or O=CC. Default: C,-DspmF,-v resp. CC,-DOscpSql,-v"
  8. echo " -O<0-4> optimization level"
  9. echo " -f<opt> special optimization"
  10. echo " -B<static|dynamic> pass to cc_harness"
  11. echo " -c continue on errors"
  12. echo " -k keep temp. files on PASS"
  13. echo " -E dump preprocessed source file with cc -E as _E.c"
  14. echo " -o orig. no -Mblib, use installed modules (5.6, 5.8)"
  15. echo " -a all. undo -Du. Unsilence scanning unused sub"
  16. echo " -q quiet"
  17. echo " -h help"
  18. echo "Without arguments try all $ntests tests. Without Option -Ox try -O0 to -O3 optimizations."
  19. }
  20. # use the actual perl from the Makefile (perl5.8.8,
  21. # perl5.10.0d-nt, perl5.11.0, ...)
  22. PERL=`grep "^PERL =" Makefile|cut -c8-`
  23. PERL=${PERL:-perl}
  24. v518=`$PERL -e'print (($] < 5.018)?0:1)'`
  25. function init {
  26. BASE=`basename $0`
  27. # if $] < 5.9 you may want to remove -Mblib for testing the core lib. -o
  28. #Mblib="`$PERL -e'print (($] < 5.009005) ? q() : q(-Mblib))'`"
  29. Mblib=${Mblib:--Iblib/arch -Iblib/lib} # B::C is now fully 5.6+5.8 backwards compatible
  30. v513="`$PERL -e'print (($] < 5.013005) ? q() : q(-fno-fold,-fno-warnings,))'`"
  31. # OCMD=${OCMD}${v513}
  32. if [ -z "$Mblib" ]; then
  33. VERS="${VERS}_global";
  34. OCMD="$PERL $Mblib -MO=C,${v513}-Dcsp,"
  35. if [ $BASE = "testcc.sh" ]; then # DrOsplt
  36. OCMD="$PERL $Mblib -MO=CC,${v513}-DOsplt,"
  37. fi
  38. else
  39. OCMD="$PERL $Mblib -MO=C,${v513}-DspF,-v,"
  40. if [ $BASE = "testcc.sh" ]; then # DoOscprSql
  41. OCMD="$PERL $Mblib -MO=CC,${v513}-DOscpSql,-v,"
  42. fi
  43. fi
  44. CONT=
  45. # 5.6: rather use -B static
  46. #CCMD="$PERL script/cc_harness -g3"
  47. # rest. -DALLOW_PERL_OPTIONS for -Dtlv
  48. #CCMD="$PERL $Mblib script/cc_harness -g3 -DALLOW_PERL_OPTIONS"
  49. CCMD="$PERL $Mblib script/cc_harness"
  50. LCMD=
  51. # On some perls I also had to add $archlib/DynaLoader/DynaLoader.a to libs in Config.pm
  52. }
  53. function vcmd {
  54. test -n "$QUIET" || echo $*
  55. $*
  56. }
  57. function pass {
  58. echo -e -n "\033[1;32mPASS \033[0;0m"
  59. echo $*
  60. }
  61. function fail {
  62. echo -e -n "\033[1;31mFAIL \033[0;0m"
  63. echo $*
  64. }
  65. function runopt {
  66. o=$1
  67. optim=$2
  68. OCMDO1="$(echo $OCMD|sed -e s/C,/C,-O$optim,/)"
  69. suff="_o${optim}"
  70. if [ "$optim" == "0" ]; then suff=""; fi
  71. rm ${o}${suff} ${o}${suff}.c 2> /dev/null
  72. if [ $optim -lt 5 ]; then CMD=$OCMDO1
  73. else CMD=$OCMD
  74. fi
  75. if [ "$o" = "ccode46" -o "$o" = "cccode46" ]; then
  76. CMD="$CMD-fstash,"
  77. fi
  78. if [ -z $qq ]; then
  79. vcmd ${CMD}-o${o}${suff}.c $o.pl 2>&1 | grep -v "$o.pl syntax OK"
  80. else
  81. vcmd ${CMD}-o${o}${suff}.c $o.pl
  82. fi
  83. test -z $CPP || vcmd $CCMD ${o}${suff}.c -c -E -o ${o}${suff}_E.c
  84. vcmd $CCMD ${o}${suff}.c $LCMD -o ${o}${suff}
  85. test -x ${o}${suff} || (test -z $CONT && exit)
  86. if [ -z "$QUIET" ]; then echo "./${o}${suff}"
  87. else echo -n "./${o}${suff} "
  88. fi
  89. mem=$(ulimit -m 2>/dev/null)
  90. err=$?
  91. test -z $err && ulimit -S -m 50000
  92. res=$(./${o}${suff}) || fail "./${o}${suff}" "errcode $?"
  93. test -z $err && ulimit -S -m $mem
  94. if [ "X$res" = "X${result[$n]}" ]; then
  95. test "X$res" = "X${result[$n]}" && pass "./${o}${suff}" "=> '$res'"
  96. if [ -z $KEEP ]; then rm ${o}${suff}_E.c ${o}${suff}.c ${o}${suff} 2>/dev/null; fi
  97. true
  98. else
  99. fail "./${o}${suff}" "=> '$str' => '$res'. Expected: '${result[$n]}'"
  100. false
  101. fi
  102. }
  103. function ctest {
  104. n=$1
  105. str=$2
  106. if [ $BASE = "testcc.sh" ]; then
  107. o="cccode$n"
  108. else
  109. o="ccode$n"
  110. fi
  111. if [ -z "$str" ]; then
  112. if [ "$n" = "08" ]; then n=8; fi
  113. if [ "$n" = "09" ]; then n=9; fi
  114. echo "${tests[${n}]}" > ${o}.pl
  115. str="${tests[${n}]}"
  116. else
  117. echo "$str" > ${o}.pl
  118. fi
  119. if [ -z "$str" ]; then
  120. true
  121. else
  122. if [ $OPTIM -ge 0 ]; then
  123. runopt "$o" "$OPTIM"
  124. else # -1
  125. rm $o.c $o ${o}_o.c ${o}_o 2> /dev/null
  126. vcmd ${OCMD}-o$o.c $o.pl
  127. test -s $o.c || (echo "empty $o.c"; test -z $CONT && exit 2)
  128. test -z $CPP || vcmd $CCMD $o.c -c -E -o ${o}_E.c
  129. vcmd $CCMD $o.c $LCMD -o $o
  130. test -x $o || (test -z $CONT && exit)
  131. if [ -z "$QUIET" ]; then echo "./$o"
  132. else echo -n "./$o "
  133. fi
  134. res=$(./$o) || (fail "./${o}${suff}" "'$?' = $?"; test -z $CONT && exit 1)
  135. if [ "X$res" = "X${result[$n]}" ]; then
  136. pass "./$o" "'$str' => '$res'"
  137. if [ -z $KEEP ]; then rm ${o}_E.c ${o}.c ${o} 2>/dev/null; fi
  138. if [ $BASE = "testcc.sh" ]; then
  139. runopt $o 1 && \
  140. runopt $o 2
  141. else
  142. runopt $o 1 && \
  143. runopt $o 2 && \
  144. runopt $o 3 && \
  145. runopt $o 4
  146. fi
  147. true
  148. else
  149. fail "./$o" "'$str' => '$res' Expected: '${result[$n]}'"
  150. test -z $CONT && exit 3
  151. fi
  152. fi
  153. fi
  154. }
  155. ntests=125
  156. declare -a tests[$ntests]
  157. declare -a result[$ntests]
  158. ncctests=23
  159. declare -a cctests[$((100+$ncctests))]
  160. declare -a ccresult[$((100+$ncctests))]
  161. tests[1]='print "hi"'
  162. result[1]='hi'
  163. tests[2]='for (1,2,3) { print if /\d/ }'
  164. result[2]='123'
  165. tests[3]='$_ = "xyxyx"; %j=(1,2); s/x/$j{print("z")}/ge; print $_'
  166. result[3]='zzz2y2y2'
  167. tests[4]='$_ = "xyxyx"; %j=(1,2); s/x/$j{print("z")}/g; print $_'
  168. if [[ $v518 -gt 0 ]]; then
  169. result[4]='zzz2y2y2'
  170. else
  171. result[4]='z2y2y2'
  172. fi
  173. tests[5]='print split /a/,"bananarama"'
  174. result[5]='bnnrm'
  175. tests[6]="{package P; sub x {print 'ya'} x}"
  176. result[6]='ya'
  177. tests[7]='@z = split /:/,"b:r:n:f:g"; print @z'
  178. result[7]='brnfg'
  179. tests[8]='sub AUTOLOAD { print 1 } &{"a"}()'
  180. result[8]='1'
  181. tests[9]='my $l_i = 3; $x = sub { print $l_i }; &$x'
  182. result[9]='3'
  183. tests[10]='my $i_i = 1;
  184. my $foo = sub {
  185. $i_i = shift if @_
  186. }; print $i_i;
  187. print &$foo(3),$i_i;'
  188. result[10]='133'
  189. # index: do fbm_compile or not
  190. tests[11]='$x="Cannot use"; print index $x, "Can"'
  191. result[11]='0'
  192. tests[12]='my $i_i=6; eval "print \$i_i\n"; print ""'
  193. result[12]='6'
  194. tests[13]='BEGIN { %h=(1=>2,3=>4) } print $h{3}'
  195. result[13]='4'
  196. tests[14]='open our $T,"a"; print "ok";'
  197. result[14]='ok'
  198. # __DATA__ handles still broken non-threaded 5.10
  199. tests[15]='print <DATA>
  200. __DATA__
  201. a
  202. b'
  203. result[15]='a
  204. b'
  205. tests[16]='BEGIN{tie @a, __PACKAGE__;sub TIEARRAY {bless{}} sub FETCH{1}}; print $a[1]'
  206. result[16]='1'
  207. tests[17]='my $i_ir=3; print 1 .. $i_ir'
  208. result[17]='123'
  209. # custom key sort
  210. tests[18]='my $h = { a=>3, b=>1 }; print sort {$h->{$a} <=> $h->{$b}} keys %$h'
  211. result[18]='ba'
  212. # fool the sort optimizer by my $p, pp_sort works ok on CC
  213. tests[19]='print sort { my $p; $b <=> $a } 1,4,3'
  214. result[19]='431'
  215. # not repro: something like this is broken in original 5.6 (Net::DNS::ZoneFile::Fast)
  216. # see new test 33
  217. tests[20]='$a="abcd123";my $r=qr/\d/;print $a =~ $r;'
  218. result[20]='1'
  219. # broken on early alpha and 5.10: run-time labels.
  220. tests[21]='sub skip_on_odd{next NUMBER if $_[0]% 2}NUMBER:for($i=0;$i<5;$i++){skip_on_odd($i);print $i;}'
  221. result[21]='024'
  222. # broken in original perl 5.6
  223. tests[22]='my $fh; BEGIN { open($fh,"<","/dev/null"); } print "ok";';
  224. result[22]='ok'
  225. # broken in perl 5.8
  226. tests[23]='package MyMod; our $VERSION = 1.3; print "ok";'
  227. result[23]='ok'
  228. # works in original perl 5.6, broken with latest B::C in 5.6, 5.8
  229. tests[24]='sub level1{return(level2()?"fail":"ok")} sub level2{0} print level1();'
  230. result[24]='ok'
  231. # enforce custom ncmp sort and count it. fails as CC in all. How to enforce icmp?
  232. # <=5.6 qsort needs two more passes here than >=5.8 merge_sort
  233. # 5.12 got it backwards and added 4 more passes.
  234. tests[25]='print sort { $i++; $b <=> $a } 1..4'
  235. result[25]="4321"
  236. # lvalue sub
  237. tests[26]='sub a:lvalue{my $a=26; ${\(bless \$a)}}sub b:lvalue{${\shift}}; print ${a(b)}';
  238. result[26]="26"
  239. # xsub constants (constant folded). newlib: 0x200, glibc: 0x100
  240. tests[27]='use Fcntl ();my $a=Fcntl::O_CREAT(); print "ok" if ( $a >= 64 && &Fcntl::O_CREAT >= 64 );'
  241. result[27]='ok'
  242. # require $fname
  243. tests[28]='my($fname,$tmp_fh);while(!open($tmp_fh,">",($fname=q{ccode28_} . rand(999999999999)))){$bail++;die "Failed to create a tmp file after 500 tries" if $bail>500;}print {$tmp_fh} q{$x="ok";1;};close($tmp_fh);sleep 1;require $fname;END{unlink($fname);};print $x;'
  244. result[28]='ok'
  245. # special old IO handling
  246. tests[29]='use IO;print "ok"'
  247. result[29]='ok'
  248. # run-time context of .., fails in CC
  249. tests[30]='@a=(4,6,1,0,0,1);sub range{(shift @a)..(shift @a)}print range();while(@a){print scalar(range())}'
  250. result[30]='456123E0'
  251. # AUTOLOAD w/o goto xsub
  252. tests[31]='package MockShell;sub AUTOLOAD{my $p=$AUTOLOAD;$p=~s/.*:://;print(join(" ",$p,@_),";");} package main; MockShell::date();MockShell::who("am","i");MockShell::ls("-l");'
  253. result[31]='date;who am i;ls -l;'
  254. # CC entertry/jmpenv_jump/leavetry
  255. tests[32]='eval{print "1"};eval{die 1};print "2";'
  256. result[32]='12'
  257. # C qr test was broken in 5.6 -- needs to load an actual file to test. See test 20.
  258. # used to error with Can't locate object method "save" via package "U??WVS?-" (perhaps you forgot to load "U??WVS?-"?) at /usr/lib/perl5/5.6.2/i686-linux/B/C.pm line 676.
  259. # fails with new constant only. still not repro (r-magic probably)
  260. tests[33]='BEGIN{unshift @INC,("t");} use qr_loaded_module; print "ok" if qr_loaded_module::qr_called_in_sub("name1")'
  261. result[33]='ok'
  262. # init of magic hashes. %ENV has e magic since a0714e2c perl.c
  263. # (Steven Schubiger 2006-02-03 17:24:49 +0100 3967) i.e. 5.8.9 but not 5.8.8
  264. tests[34]='my $x=$ENV{TMPDIR};print "ok"'
  265. result[34]='ok'
  266. # static method_named. fixed with 1.16
  267. tests[35]='package dummy;my $i=0;sub meth{print $i++};package main;dummy->meth(1);my dummy $o = bless {},"dummy";$o->meth("const");my $meth="meth";$o->$meth("const");dummy->$meth("const");dummy::meth("dummy","const")'
  268. result[35]='01234'
  269. # HV self-ref
  270. tests[36]='my ($rv, %hv); %hv = ( key => \$rv ); $rv = \%hv; print "ok";'
  271. result[36]='ok'
  272. # AV self-ref
  273. tests[37]='my ($rv, @av); @av = ( \$rv ); $rv = \@av; print "ok";'
  274. result[37]='ok'
  275. # constant autoload loop crash test
  276. tests[38]='for(1 .. 1024) { if (open(my $null_fh,"<","/dev/null")) { seek($null_fh,0,SEEK_SET); close($null_fh); $ok++; } }if ($ok == 1024) { print "ok"; }'
  277. result[38]='ok'
  278. # check re::is_regexp, and on 5.12 if being upgraded to SVt_REGEXP
  279. # => Undefined subroutine &re::is_regexp with B-C-1.19, even with -ure
  280. tests[39]='{$a=qr/x/;print($]<5.010?1:re::is_regexp($a))}'
  281. result[39]='1'
  282. # String with a null byte -- used to generate broken .c on 5.6.2 with static pvs
  283. tests[40]='my $var="this string has a null \\000 byte in it";print "ok";'
  284. result[40]='ok'
  285. # Shared scalar, n magic. => Don't know how to handle magic of type \156.
  286. usethreads=""
  287. #usethreads="`$PERL -MConfig -e'print ($Config{useithreads} ? q(use threads;) : q())'`"
  288. #usethreads='BEGIN{use Config; unless ($Config{useithreads}) {print "ok"; exit}} '
  289. #;threads->create(sub{$s="ok"})->join;
  290. # not yet testing n, only P
  291. tests[41]=$usethreads'use threads::shared;{my $s="ok";share($s);print $s}'
  292. result[41]='ok'
  293. # Shared aggregate, P magic
  294. tests[42]=$usethreads'use threads::shared;my %h : shared; print "ok"'
  295. result[42]='ok'
  296. # Aggregate element, n + p magic
  297. tests[43]=$usethreads'use threads::shared;my @a : shared; $a[0]="ok"; print $a[0]'
  298. result[43]='ok'
  299. # perl #72922 (5.11.4 fails with magic_killbackrefs)
  300. tests[44]='use Scalar::Util "weaken";my $re1=qr/foo/;my $re2=$re1;weaken($re2);print "ok" if $re3=qr/$re1/;'
  301. result[44]='ok'
  302. # test dynamic loading
  303. tests[45]='use Data::Dumper ();Data::Dumper::Dumpxs({});print "ok";'
  304. result[45]='ok'
  305. # issue 79: Exporter:: stash missing in main::
  306. #tests[46]='use Exporter; if (exists $main::{"Exporter::"}) { print "ok"; }'
  307. tests[46]='use Exporter; print "ok" if %main::Exporter::'
  308. #tests[46]='use Exporter; print "ok" if scalar(keys(%main::Exporter::)) > 2'
  309. result[46]='ok'
  310. # non-tied av->MAGICAL
  311. tests[47]='@ISA=(q(ok));print $ISA[0];'
  312. result[47]='ok'
  313. # END block del_backref with bytecode only
  314. tests[48]='my $s=q{ok};END{print $s}'
  315. result[48]='ok'
  316. # even this failed until r1000 (AvFILL 3 of END)
  317. #tests[48]='print q{ok};END{}'
  318. #result[48]='ok'
  319. # no-fold
  320. tests[49]='print q(ok) if "test" =~ /es/i;'
  321. result[49]='ok'
  322. # @ISA issue 64
  323. tests[50]='package Top;sub top{q(ok)};package Next;our @ISA=qw(Top);package main;print Next->top();'
  324. result[50]='ok'
  325. # XXX TODO sigwarn $w = B::NULL without -v
  326. tests[51]='$SIG{__WARN__}=sub{print "ok"};warn 1;'
  327. result[51]='ok'
  328. # check if general signals work
  329. tests[511]='BEGIN{$SIG{USR1}=sub{$w++;};} kill USR1 => $$; print q(ok) if $w';
  330. result[511]='ok'
  331. #-------------
  332. # issue27
  333. tests[227]='require LWP::UserAgent;print q(ok);'
  334. result[227]='ok'
  335. #issue 24
  336. tests[224]='dbmopen(%H,q(f),0644);print q(ok);'
  337. result[224]='ok'
  338. tests[68]='package A;
  339. sub test {
  340. use Data::Dumper ();
  341. /^(.*?)\d+$/;
  342. "Some::Package"->new();
  343. }
  344. print "ok"'
  345. result[68]='ok'
  346. # issue71
  347. tests[71]='
  348. package my;
  349. our @a;
  350. sub f {
  351. my($alias,$name)=@_;
  352. unshift(@a, $alias => $name);
  353. my $find = "ok";
  354. my $val = $a[1];
  355. if ( ref($alias) eq "Regexp" && $find =~ $alias ) {
  356. eval $val;
  357. }
  358. $find
  359. }
  360. package main;
  361. *f=*my::f;
  362. print "ok" if f(qr/^(.*)$/ => q("\L$1"));'
  363. result[71]="ok"
  364. # object call: method_named with args.
  365. tests[72]='package dummy;sub meth{print "ok"};package main;my dummy $o = bless {},"dummy"; $o->meth("const")'
  366. result[72]='ok'
  367. # object call: dynamic method_named with args.
  368. tests[73]='package dummy;sub meth{print "ok"};package main;my $meth="meth";my $o = bless {},"dummy"; $o->$meth("const")'
  369. result[73]='ok'
  370. tests[74]='package dummy;
  371. my $invoked_as_script = !caller();
  372. __PACKAGE__->script(@ARGV) if $invoked_as_script;
  373. sub script {my($package,@args)=@_;print "ok"}'
  374. result[74]='ok'
  375. # issue 71_2+3: cop_warnings issue76 and const destruction issue71 fixed
  376. # ok with "utf-8-strict"
  377. tests[75]='#TODO
  378. use Encode;
  379. my $x = "abc";
  380. print "ok" if "abc" eq Encode::decode("UTF-8", $x);'
  381. result[75]='ok'
  382. tests[76]='use warnings;
  383. { no warnings q(void); # issue76 lexwarn
  384. length "ok";
  385. print "ok"
  386. };'
  387. result[76]='ok'
  388. tests[81]='sub int::check {1} #create int package for types
  389. sub x(int,int) { @_ } #cvproto
  390. my $o = prototype \&x;
  391. if ($o eq "int,int") {print "o"}else{print $o};
  392. sub y($) { @_ } #cvproto
  393. my $p = prototype \&y;
  394. if ($p eq q($)) {print "k"}else{print $p};
  395. require bytes;
  396. sub my::length ($) { # possible prototype mismatch vs _
  397. if ( bytes->can(q(length)) ) {
  398. *length = *bytes::length;
  399. goto &bytes::length;
  400. }
  401. return CORE::length( $_[0] );
  402. }
  403. print my::length($p);'
  404. result[81]='ok1'
  405. tests[90]='my $s = q(test string);
  406. $s =~ s/(?<first>test) (?<second>string)/\2 \1/g;
  407. print q(o) if $s eq q(string test);
  408. q(test string) =~ /(?<first>\w+) (?<second>\w+)/;
  409. print q(k) if $+{first} eq q(test);'
  410. result[90]='ok'
  411. tests[901]='my %errs = %!; # t/op/magic.t Errno compiled in
  412. print q(ok) if defined ${"!"}{ENOENT};'
  413. result[901]='ok'
  414. tests[902]='my %errs = %{"!"}; # t/op/magic.t Errno to be loaded at run-time
  415. print q(ok) if defined ${"!"}{ENOENT};'
  416. result[902]='ok'
  417. # IO handles
  418. tests[91]='# issue59
  419. use strict;
  420. use warnings;
  421. use IO::Socket;
  422. my $remote = IO::Socket::INET->new( Proto => "tcp", PeerAddr => "perl.org", PeerPort => "80" );
  423. print $remote "GET / HTTP/1.0" . "\r\n\r\n";
  424. my $result = <$remote>;
  425. $result =~ m|HTTP/1.1 200 OK| ? print "ok" : print $result;
  426. close $remote;'
  427. result[91]='ok'
  428. tests[93]='#SKIP
  429. my ($pid, $out, $in);
  430. BEGIN {
  431. local(*FPID);
  432. $pid = open(FPID, "echo <<EOF |"); # DIE
  433. open($out, ">&STDOUT"); # EASY
  434. open(my $tmp, ">", "pcc.tmp"); # HARD to get filename, WARN
  435. print $tmp "test\n";
  436. close $tmp; # OK closed
  437. open($in, "<", "pcc.tmp"); # HARD to get filename, WARN
  438. }
  439. # === run-time ===
  440. print $out "o";
  441. kill 0, $pid; # BAD! warn? die?
  442. print "k" if "test" eq read $in, my $x, 4;
  443. unlink "pcc.tmp";
  444. '
  445. result[93]='o'
  446. tests[931]='my $f;BEGIN{open($f,"<README");}read $f,my $in, 2; print "ok"'
  447. result[931]='ok'
  448. tests[932]='my $f;BEGIN{open($f,">&STDOUT");}print $f "ok"'
  449. result[932]='ok'
  450. tests[95]='#TODO IO::Handle
  451. use IO::Socket::SSL();
  452. my IO::Handle $handle = IO::Socket::SSL->new(SSL_verify_mode =>0);
  453. $handle->blocking(0);
  454. print "ok";'
  455. result[95]='ok'
  456. tests[97]='use v5.12; print q(ok);'
  457. result[97]='ok'
  458. # from here on we test CC specifics only
  459. # CC types and arith
  460. tests[101]='my ($r_i,$i_i,$d_d)=(0,2,3.0); $r_i=$i_i*$i_i; $r_i*=$d_d; print $r_i;'
  461. result[101]='12'
  462. # CC cond_expr, stub, scope
  463. tests[102]='if ($x eq "2"){}else{print "ok"}'
  464. result[102]='ok'
  465. # CC stringify, srefgen. TODO: use B; fails
  466. tests[103]='require B; my $x=1e1; my $s="$x"; print ref B::svref_2object(\$s)'
  467. result[103]='B::PV'
  468. # CC reset
  469. tests[104]='@a=(1..4);while($a=shift@a){print $a;}continue{$a=~/2/ and reset q(a);}'
  470. result[104]='12'
  471. # CC -ftype-attr
  472. #tests[105]='$int::dummy=0;$double::dummy=0;my int $r;my $i:int=2;our double $d=3.0; $r=$i*$i; $r*=$d; print $r;'
  473. tests[105]='%int::;%double::;my int $r;my int $i=2;our double $d=3.0; $r=$i*$i; $r*=$d; print $r;'
  474. result[105]='12'
  475. # issue35
  476. tests[110]='sub new{}sub test{{my $x=1;my $y=$x+1;}my $x=2;if($x!=3){4;}}'
  477. result[110]=''
  478. # issue36
  479. tests[111]='sub f{shift==2}sub test{while(1){last if f(2);}while(1){last if f(2);}}'
  480. result[111]=''
  481. # issue37
  482. tests[112]='my $x;$x||=1;print "ok" if $x;'
  483. result[112]='ok'
  484. # issue38
  485. tests[113]='my $x=2;$x=$x||3;print "ok" if $x==2;'
  486. result[113]='ok'
  487. # issue39
  488. tests[114]='sub f1{0}sub f2{my $x;if(f1()){}if($x){}else{[$x]}}my @a=f2();print "ok";'
  489. result[114]='ok'
  490. # issue42
  491. tests[115]='sub f1{1}f1();print do{7;2},"\n";'
  492. result[115]='2'
  493. # issue44
  494. tests[116]='my @a=(1,2);print $a[0],"\n";'
  495. result[116]='1'
  496. # issue45
  497. tests[117]='my $x;$x//=1;print "ok" if $x;'
  498. result[117]='ok'
  499. # issue46
  500. tests[118]='my $pattern="x";"foo"=~/$pattern/o;print "ok";'
  501. result[118]='ok'
  502. # issue47
  503. tests[119]='my $f=sub{while(1){return(1);}};print $f->(),"\n";'
  504. result[119]='1'
  505. # issue48
  506. tests[120]='sub f{()}print((my ($v)=f())?1:2,"\n");'
  507. result[120]='2'
  508. # issue49
  509. tests[121]='while(1){while(1){last;}last;}print "ok"'
  510. result[121]='ok'
  511. # issue51
  512. tests[122]='my ($p1,$p2)=(80,80);if($p1<=23&&23<=$p2){print "telnet\n";}elsif ($p1 <= 80 && 80 <= $p2){print "http\n";}else{print "fail\n"}'
  513. result[122]='http'
  514. # issue52
  515. tests[123]='my $x;my $y = 1;$x and $y == 2;print $y == 1 ? "ok\n" : "fail\n";'
  516. result[123]='ok'
  517. # issue125 DynaLoader::bootstrap_inherit [perl #119577]
  518. tests[125]='use Net::LibIDN; print q(ok);'
  519. result[125]='ok'
  520. # saving recursive functions sometimes recurses in the compiler. this not, but Moose stucks in Pod::Simple
  521. tests[99]='package my;sub recurse{my $i=shift;recurse(++$i)unless $i>5000;print"ok";exit};package main;my::recurse(1)'
  522. result[99]='ok'
  523. if [[ $v518 -gt 0 ]]; then
  524. tests[130]='no warnings "experimental::lexical_subs";use feature "lexical_subs";my sub p{q(ok)}; my $a=\&p;print p;'
  525. result[130]='ok'
  526. fi
  527. #issue 30
  528. tests[230]='sub f1 { my($self) = @_; $self->f2;} sub f2 {} sub new {} print "@ARGV\n";'
  529. result[230]=''
  530. init
  531. #
  532. # getopts for -q -k -E -Du,-q -v -O2, -a -c -fro-inc
  533. while getopts "hackoED:B:O:f:q" opt
  534. do
  535. if [ "$opt" = "q" ]; then
  536. QUIET=1
  537. CCMD="$CCMD -q"
  538. fi
  539. if [ "$opt" = "o" ]; then Mblib=" "; init; fi
  540. if [ "$opt" = "c" ]; then CONT=1; fi
  541. if [ "$opt" = "k" ]; then KEEP=1; fi
  542. if [ "$opt" = "E" ]; then CPP=1; fi
  543. if [ "$opt" = "h" ]; then help; exit; fi
  544. # -D options: u,-q for quiet, no -D for verbose, -D- for no gcc warnings
  545. if [ "$opt" = "D" ]; then
  546. OCMD="$PERL $Mblib -MO=C,-D${OPTARG},"
  547. if [ $BASE = "testcc.sh" ]; then
  548. OCMD="$PERL $Mblib -MO=CC,-D${OPTARG},"
  549. fi
  550. if [ -z "${OPTARG/-/}" ]; then
  551. CCMD="$CCMD -d"
  552. fi
  553. fi
  554. # -B dynamic or -B static
  555. if [ "$opt" = "B" ]; then
  556. CCMD="$CCMD -B${OPTARG}"
  557. fi
  558. if [ "$opt" = "O" ]; then OPTIM="$OPTARG"; fi
  559. if [ "$opt" = "f" ]; then
  560. OCMD="$(echo $OCMD|sed -e "s/C,/C,-f$OPTARG,/")"
  561. fi
  562. if [ "$opt" = "a" ]; then # replace -Du, by -Do
  563. OCMD="$(echo $OCMD|sed -r -e 's/(-D.*)u,/\1o,/')"
  564. fi
  565. done
  566. if [ "$(perl -V:gccversion)" != "gccversion='';" ]; then
  567. if [ "$(uname)" = "Darwin" ]; then
  568. CCMD="$CCMD -g -fno-openmp -fno-var-tracking"
  569. else
  570. CCMD="$CCMD -g3"
  571. fi
  572. fi
  573. if [ -z $OPTIM ]; then OPTIM=-1; fi # all
  574. if [ -z "$QUIET" ]; then
  575. make
  576. else
  577. # O from 5.6 does not support -qq
  578. qq="`$PERL -e'print (($] < 5.007) ? q() : q(-qq,))'`"
  579. # replace -D*,-v by -q
  580. OCMD="$(echo $OCMD |sed -e 's/-D.*,//' -e 's/,-v,/,/' -e s/-MO=/-MO=$qq/)"
  581. OCMDO1="$(echo $OCMDO1|sed -e 's/-D.*,//' -e 's/,-v,/,/' -e s/-MO=/-MO=$qq/)"
  582. OCMDO2="$(echo $OCMDO2|sed -e 's/-D.*,//' -e 's/,-v,/,/' -e s/-MO=/-MO=$qq/)"
  583. OCMDO3="$(echo $OCMDO3|sed -e 's/-D.*,//' -e 's/,-v,/,/' -e s/-MO=/-MO=$qq/)"
  584. OCMDO4="$(echo $OCMDO4|sed -e 's/-D.*,//' -e 's/,-v,/,/' -e s/-MO=/-MO=$qq/)"
  585. # gnu make?
  586. make -s >/dev/null || make 2&>1 >/dev/null
  587. fi
  588. # need to shift the options
  589. while [ -n "$1" -a "${1:0:1}" = "-" ]; do shift; done
  590. if [ -n "$1" ]; then
  591. while [ -n "$1" ]; do
  592. ctest $1
  593. shift
  594. done
  595. else
  596. for b in $(seq $ntests); do
  597. ctest $b
  598. done
  599. if [ $BASE = "testcc.sh" ]; then
  600. for b in $(seq 101 $(($ncctests+100))); do
  601. ctest $b
  602. done
  603. fi
  604. fi
  605. # 562 c: 15,25,27
  606. # 58 c: 27,29_i
  607. # 58 cc: 15,18,21,25,26_o,27,29
  608. # 510 c: 15
  609. # 510 cc: 11,15,29
  610. # 511 c: 11,15,16,29
  611. # http://www.nntp.perl.org/group/perl.perl5.porters/2005/07/msg103315.html
  612. # FAIL for B::CC should be covered by test 18