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