1*0Sstevel@tonic-gate#!./perl 2*0Sstevel@tonic-gate 3*0Sstevel@tonic-gate# 4*0Sstevel@tonic-gate# test recursive functions. 5*0Sstevel@tonic-gate# 6*0Sstevel@tonic-gate 7*0Sstevel@tonic-gateBEGIN { 8*0Sstevel@tonic-gate chdir 't' if -d 't'; 9*0Sstevel@tonic-gate @INC = qw(. ../lib); 10*0Sstevel@tonic-gate require "test.pl"; 11*0Sstevel@tonic-gate plan(tests => 28); 12*0Sstevel@tonic-gate} 13*0Sstevel@tonic-gate 14*0Sstevel@tonic-gateuse strict; 15*0Sstevel@tonic-gate 16*0Sstevel@tonic-gatesub gcd { 17*0Sstevel@tonic-gate return gcd($_[0] - $_[1], $_[1]) if ($_[0] > $_[1]); 18*0Sstevel@tonic-gate return gcd($_[0], $_[1] - $_[0]) if ($_[0] < $_[1]); 19*0Sstevel@tonic-gate $_[0]; 20*0Sstevel@tonic-gate} 21*0Sstevel@tonic-gate 22*0Sstevel@tonic-gatesub factorial { 23*0Sstevel@tonic-gate $_[0] < 2 ? 1 : $_[0] * factorial($_[0] - 1); 24*0Sstevel@tonic-gate} 25*0Sstevel@tonic-gate 26*0Sstevel@tonic-gatesub fibonacci { 27*0Sstevel@tonic-gate $_[0] < 2 ? 1 : fibonacci($_[0] - 2) + fibonacci($_[0] - 1); 28*0Sstevel@tonic-gate} 29*0Sstevel@tonic-gate 30*0Sstevel@tonic-gate# Highly recursive, highly aggressive. 31*0Sstevel@tonic-gate# Kids, don't try this at home. 32*0Sstevel@tonic-gate# 33*0Sstevel@tonic-gate# For example ackermann(4,1) will take quite a long time. 34*0Sstevel@tonic-gate# It will simply eat away your memory. Trust me. 35*0Sstevel@tonic-gate 36*0Sstevel@tonic-gatesub ackermann { 37*0Sstevel@tonic-gate return $_[1] + 1 if ($_[0] == 0); 38*0Sstevel@tonic-gate return ackermann($_[0] - 1, 1) if ($_[1] == 0); 39*0Sstevel@tonic-gate ackermann($_[0] - 1, ackermann($_[0], $_[1] - 1)); 40*0Sstevel@tonic-gate} 41*0Sstevel@tonic-gate 42*0Sstevel@tonic-gate# Highly recursive, highly boring. 43*0Sstevel@tonic-gate 44*0Sstevel@tonic-gatesub takeuchi { 45*0Sstevel@tonic-gate $_[1] < $_[0] ? 46*0Sstevel@tonic-gate takeuchi(takeuchi($_[0] - 1, $_[1], $_[2]), 47*0Sstevel@tonic-gate takeuchi($_[1] - 1, $_[2], $_[0]), 48*0Sstevel@tonic-gate takeuchi($_[2] - 1, $_[0], $_[1])) 49*0Sstevel@tonic-gate : $_[2]; 50*0Sstevel@tonic-gate} 51*0Sstevel@tonic-gate 52*0Sstevel@tonic-gateis(gcd(1147, 1271), 31, "gcd(1147, 1271) == 31"); 53*0Sstevel@tonic-gate 54*0Sstevel@tonic-gateis(gcd(1908, 2016), 36, "gcd(1908, 2016) == 36"); 55*0Sstevel@tonic-gate 56*0Sstevel@tonic-gateis(factorial(10), 3628800, "factorial(10) == 3628800"); 57*0Sstevel@tonic-gate 58*0Sstevel@tonic-gateis(factorial(factorial(3)), 720, "factorial(factorial(3)) == 720"); 59*0Sstevel@tonic-gate 60*0Sstevel@tonic-gateis(fibonacci(10), 89, "fibonacci(10) == 89"); 61*0Sstevel@tonic-gate 62*0Sstevel@tonic-gateis(fibonacci(fibonacci(7)), 17711, "fibonacci(fibonacci(7)) == 17711"); 63*0Sstevel@tonic-gate 64*0Sstevel@tonic-gatemy @ack = qw(1 2 3 4 2 3 4 5 3 5 7 9 5 13 29 61); 65*0Sstevel@tonic-gate 66*0Sstevel@tonic-gatefor my $x (0..3) { 67*0Sstevel@tonic-gate for my $y (0..3) { 68*0Sstevel@tonic-gate my $a = ackermann($x, $y); 69*0Sstevel@tonic-gate is($a, shift(@ack), "ackermann($x, $y) == $a"); 70*0Sstevel@tonic-gate } 71*0Sstevel@tonic-gate} 72*0Sstevel@tonic-gate 73*0Sstevel@tonic-gatemy ($x, $y, $z) = (18, 12, 6); 74*0Sstevel@tonic-gate 75*0Sstevel@tonic-gateis(takeuchi($x, $y, $z), $z + 1, "takeuchi($x, $y, $z) == $z + 1"); 76*0Sstevel@tonic-gate 77*0Sstevel@tonic-gate{ 78*0Sstevel@tonic-gate sub get_first1 { 79*0Sstevel@tonic-gate get_list1(@_)->[0]; 80*0Sstevel@tonic-gate } 81*0Sstevel@tonic-gate 82*0Sstevel@tonic-gate sub get_list1 { 83*0Sstevel@tonic-gate return [curr_test] unless $_[0]; 84*0Sstevel@tonic-gate my $u = get_first1(0); 85*0Sstevel@tonic-gate [$u]; 86*0Sstevel@tonic-gate } 87*0Sstevel@tonic-gate my $x = get_first1(1); 88*0Sstevel@tonic-gate ok($x, "premature FREETMPS (change 5699)"); 89*0Sstevel@tonic-gate} 90*0Sstevel@tonic-gate 91*0Sstevel@tonic-gate{ 92*0Sstevel@tonic-gate sub get_first2 { 93*0Sstevel@tonic-gate return get_list2(@_)->[0]; 94*0Sstevel@tonic-gate } 95*0Sstevel@tonic-gate 96*0Sstevel@tonic-gate sub get_list2 { 97*0Sstevel@tonic-gate return [curr_test] unless $_[0]; 98*0Sstevel@tonic-gate my $u = get_first2(0); 99*0Sstevel@tonic-gate return [$u]; 100*0Sstevel@tonic-gate } 101*0Sstevel@tonic-gate my $x = get_first2(1); 102*0Sstevel@tonic-gate ok($x, "premature FREETMPS (change 5699)"); 103*0Sstevel@tonic-gate} 104*0Sstevel@tonic-gate 105*0Sstevel@tonic-gate{ 106*0Sstevel@tonic-gate local $^W = 0; # We do not need recursion depth warning. 107*0Sstevel@tonic-gate 108*0Sstevel@tonic-gate sub sillysum { 109*0Sstevel@tonic-gate return $_[0] + ($_[0] > 0 ? sillysum($_[0] - 1) : 0); 110*0Sstevel@tonic-gate } 111*0Sstevel@tonic-gate 112*0Sstevel@tonic-gate is(sillysum(1000), 1000*1001/2, "recursive sum of 1..1000"); 113*0Sstevel@tonic-gate} 114*0Sstevel@tonic-gate 115*0Sstevel@tonic-gate# check ok for recursion depth > 65536 116*0Sstevel@tonic-gate{ 117*0Sstevel@tonic-gate my $r; 118*0Sstevel@tonic-gate eval { 119*0Sstevel@tonic-gate $r = runperl( 120*0Sstevel@tonic-gate nolib => 1, 121*0Sstevel@tonic-gate stderr => 1, 122*0Sstevel@tonic-gate prog => q{$d=0; $e=1; sub c { ++$d; if ($d > 66000) { $e=0 } else { c(); c() unless $d % 32768 } --$d } c(); exit $e}); 123*0Sstevel@tonic-gate }; 124*0Sstevel@tonic-gate SKIP: { 125*0Sstevel@tonic-gate skip("Out of memory -- increase your data/heap?", 2) 126*0Sstevel@tonic-gate if $r =~ /Out of memory/i; 127*0Sstevel@tonic-gate is($r, '', "64K deep recursion - no output expected"); 128*0Sstevel@tonic-gate 129*0Sstevel@tonic-gate if ($^O eq 'MacOS') { 130*0Sstevel@tonic-gate ok(1, "$^O: \$? is unreliable"); 131*0Sstevel@tonic-gate } else { 132*0Sstevel@tonic-gate is($?, 0, "64K deep recursion - no coredump expected"); 133*0Sstevel@tonic-gate } 134*0Sstevel@tonic-gate 135*0Sstevel@tonic-gate } 136*0Sstevel@tonic-gate} 137*0Sstevel@tonic-gate 138