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
129      if ($^O eq 'MacOS') {
130          ok(1, "$^O: \$? is unreliable");
131      } else {
132          is($?, 0, "64K deep recursion - no coredump expected");
133      }
134
135  }
136}
137
138