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