File: ToConstant.t

package info (click to toggle)
libconstant-defer-perl 6-3
  • links: PTS, VCS
  • area: main
  • in suites: bookworm, sid, trixie
  • size: 288 kB
  • sloc: perl: 1,603; sh: 128; makefile: 2
file content (133 lines) | stat: -rw-r--r-- 3,520 bytes parent folder | download | duplicates (4)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
#!/usr/bin/perl

# Copyright 2008, 2009 Kevin Ryde

# This file is part of constant-defer.
#
# constant-defer is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# constant-defer is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with constant-defer.  If not, see <http://www.gnu.org/licenses/>.

use strict;
use warnings;
use Memoize::ToConstant;
use Test::More tests => 22;

SKIP: { eval 'use Test::NoWarnings; 1'
          or skip 'Test::NoWarnings not available', 1; }

my $want_version = 1;
ok ($Memoize::ToConstant::VERSION >= $want_version,
    'VERSION variable');
ok (Memoize::ToConstant->VERSION  >= $want_version,
    'VERSION class method');
Memoize::ToConstant->VERSION ($want_version);


# basic use
{
  my $foo_runs = 0;
  sub foo { $foo_runs = 1; return 123 }

  my $orig_code;
  BEGIN { $orig_code = \&foo; }

  use Memoize::ToConstant 'foo';

  is (foo(), 123, 'foo() first run');
  is ($foo_runs, 1, 'foo() first runs code');

  require Scalar::Util;
  Scalar::Util::weaken ($orig_code);
  is ($orig_code, undef, 'orig foo() code garbage collected');

  $foo_runs = 0;
  is (foo(), 123, 'foo() second run');
  is ($foo_runs, 0, 'foo() second doesn\'t run code');
}

{
  my $succeeds = (eval { Memoize::ToConstant->import('nosuchfunc') }
                  ? 1 : 0);
  is ($succeeds, 0, 'no such func provokes die');
}

{
  my $succeeds = 0;
  BEGIN {
    ##no critic (BuiltinFunctions::ProhibitStringyEval)
    if (eval "use Memoize::ToConstant 'before'; 1") {
      $succeeds = 1;
    }
  }
  sub before { return 789 }

  is ($succeeds, 0, 'memoize before defined provokes die');
}

{
  my $runs = 0;
  sub Some::Non::Package::Place::func { $runs = 1; return 'xyz' }
  use Memoize::ToConstant 'Some::Non::Package::Place::func';

  is (Some::Non::Package::Place::func(), 'xyz',
      'explicit package first run');
  is ($runs, 1,
      'explicit package first run runs code');

  $runs = 0;
  is (Some::Non::Package::Place::func(), 'xyz',
      'explicit package second run');
  is ($runs, 0,
      'explicit package second run doesn\'t run code');
}

{
  my $runs = 0;
  sub three { $runs = 1;
              return ('a','b','c') }
  use Memoize::ToConstant 'three';

  is_deeply ([ three() ], [ 'a', 'b', 'c' ],
             'three return values first run');
  is ($runs, 1,
      'three return values first run runs code');

  $runs = 0;
  is_deeply ([ three() ], [ 'a', 'b', 'c' ],
             'three return values second run');
  is ($runs, 0,
      'three return values second run doesn\'t run code');
}

{
  my $runs = 0;
  sub three_scalar { $runs = 1;
                     return ('a','b','c') }
  use Memoize::ToConstant 'three_scalar';

  my $got = three_scalar();
  is ($got, 3,
      'three values in scalar context return values first run');
  is ($runs, 1,
      'three values in scalar context return values first run runs code');

  $runs = 0;
  $got = three_scalar();
  is ($got, 3,
      'three values in scalar context return values second run');
  is ($runs, 0,
      'three values in scalar context return values second run doesn\'t run code');
}

exit 0;