1#!/usr/bin/perl
2
3# Copyright 2008, 2009 Kevin Ryde
4
5# This file is part of constant-defer.
6#
7# constant-defer is free software; you can redistribute it and/or modify it
8# under the terms of the GNU General Public License as published by the Free
9# Software Foundation; either version 3, or (at your option) any later
10# version.
11#
12# constant-defer is distributed in the hope that it will be useful, but
13# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
14# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
15# for more details.
16#
17# You should have received a copy of the GNU General Public License along
18# with constant-defer.  If not, see <http://www.gnu.org/licenses/>.
19
20use strict;
21use warnings;
22use Memoize::ToConstant;
23use Test::More tests => 22;
24
25SKIP: { eval 'use Test::NoWarnings; 1'
26          or skip 'Test::NoWarnings not available', 1; }
27
28my $want_version = 1;
29ok ($Memoize::ToConstant::VERSION >= $want_version,
30    'VERSION variable');
31ok (Memoize::ToConstant->VERSION  >= $want_version,
32    'VERSION class method');
33Memoize::ToConstant->VERSION ($want_version);
34
35
36# basic use
37{
38  my $foo_runs = 0;
39  sub foo { $foo_runs = 1; return 123 }
40
41  my $orig_code;
42  BEGIN { $orig_code = \&foo; }
43
44  use Memoize::ToConstant 'foo';
45
46  is (foo(), 123, 'foo() first run');
47  is ($foo_runs, 1, 'foo() first runs code');
48
49  require Scalar::Util;
50  Scalar::Util::weaken ($orig_code);
51  is ($orig_code, undef, 'orig foo() code garbage collected');
52
53  $foo_runs = 0;
54  is (foo(), 123, 'foo() second run');
55  is ($foo_runs, 0, 'foo() second doesn\'t run code');
56}
57
58{
59  my $succeeds = (eval { Memoize::ToConstant->import('nosuchfunc') }
60                  ? 1 : 0);
61  is ($succeeds, 0, 'no such func provokes die');
62}
63
64{
65  my $succeeds = 0;
66  BEGIN {
67    ##no critic (BuiltinFunctions::ProhibitStringyEval)
68    if (eval "use Memoize::ToConstant 'before'; 1") {
69      $succeeds = 1;
70    }
71  }
72  sub before { return 789 }
73
74  is ($succeeds, 0, 'memoize before defined provokes die');
75}
76
77{
78  my $runs = 0;
79  sub Some::Non::Package::Place::func { $runs = 1; return 'xyz' }
80  use Memoize::ToConstant 'Some::Non::Package::Place::func';
81
82  is (Some::Non::Package::Place::func(), 'xyz',
83      'explicit package first run');
84  is ($runs, 1,
85      'explicit package first run runs code');
86
87  $runs = 0;
88  is (Some::Non::Package::Place::func(), 'xyz',
89      'explicit package second run');
90  is ($runs, 0,
91      'explicit package second run doesn\'t run code');
92}
93
94{
95  my $runs = 0;
96  sub three { $runs = 1;
97              return ('a','b','c') }
98  use Memoize::ToConstant 'three';
99
100  is_deeply ([ three() ], [ 'a', 'b', 'c' ],
101             'three return values first run');
102  is ($runs, 1,
103      'three return values first run runs code');
104
105  $runs = 0;
106  is_deeply ([ three() ], [ 'a', 'b', 'c' ],
107             'three return values second run');
108  is ($runs, 0,
109      'three return values second run doesn\'t run code');
110}
111
112{
113  my $runs = 0;
114  sub three_scalar { $runs = 1;
115                     return ('a','b','c') }
116  use Memoize::ToConstant 'three_scalar';
117
118  my $got = three_scalar();
119  is ($got, 3,
120      'three values in scalar context return values first run');
121  is ($runs, 1,
122      'three values in scalar context return values first run runs code');
123
124  $runs = 0;
125  $got = three_scalar();
126  is ($got, 3,
127      'three values in scalar context return values second run');
128  is ($runs, 0,
129      'three values in scalar context return values second run doesn\'t run code');
130}
131
132exit 0;
133
134