1#!/usr/bin/perl -w
2
3use strict;
4use Test::More;
5
6BEGIN
7{
8    eval 'use File::Temp';
9    if ($@)
10    {
11        plan skip_all => 'Need File::Temp for this test';
12    }
13    else
14    {
15        plan tests => 9;
16    }
17}
18
19use Devel::Peek qw( SvREFCNT );
20use File::Temp qw( tempfile );
21use Params::Validate qw( validate SCALAR HANDLE );
22
23{
24    my $fh = tempfile();
25    my @p = ( foo => 1,
26              bar => $fh,
27            );
28
29    my $ref = val1(@p);
30
31    eval { $ref->{foo} = 2 };
32    ok( ! $@, 'returned hashref values are not read only' );
33    is( $ref->{foo}, 2, 'double check that setting value worked' );
34    is( $fh, $ref->{bar}, 'filehandle is not copied during validation' );
35}
36
37{
38    package ScopeTest;
39
40    my $live = 0;
41
42    sub new { $live++; bless {}, shift }
43    sub DESTROY { $live-- }
44
45    sub Live { $live }
46}
47
48{
49    my @p = ( foo => ScopeTest->new() );
50
51    is( ScopeTest->Live(), 1,
52        'one live object' );
53
54    my $ref = val2(@p);
55
56    isa_ok( $ref->{foo}, 'ScopeTest' );
57
58    @p = ();
59
60    is( ScopeTest->Live(), 1,
61        'still one live object' );
62
63    ok( defined $ref->{foo},
64        'foo key stays in scope after original version goes out of scope' );
65    is( SvREFCNT( $ref->{foo} ), 1,
66        'ref count for reference is 1' );
67
68    undef $ref->{foo};
69
70    is( ScopeTest->Live(), 0,
71        'no live objects' );
72}
73
74sub val1
75{
76    my $ref = validate( @_,
77                        { foo => { type => SCALAR },
78                          bar => { type => HANDLE, optional => 1 },
79                        },
80                      );
81
82    return $ref;
83}
84
85sub val2
86{
87    my $ref = validate( @_,
88                        { foo => 1,
89                        },
90                      );
91
92    return $ref;
93}
94