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