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