8 # this must come before main, or tests will fail
13 @ISA = qw( Tie::Scalar );
15 sub new { 'Fooled you.' }
20 use Test::More tests => 13;
22 use_ok( 'Tie::Scalar' );
24 # these are "abstract virtual" parent methods
25 for my $method qw( TIESCALAR FETCH STORE ) {
26 eval { Tie::Scalar->$method() };
27 like( $@, qr/doesn't define a $method/, "croaks on inherited $method()" );
30 # the default value is undef
31 my $scalar = Tie::StdScalar->TIESCALAR();
32 is( $$scalar, undef, 'used TIESCALAR, default value is still undef' );
34 # Tie::StdScalar redirects to TIESCALAR
35 $scalar = Tie::StdScalar->new();
36 is( $$scalar, undef, 'used new(), default value is still undef' );
38 # this approach should work as well
39 tie $scalar, 'Tie::StdScalar';
40 is( $$scalar, undef, 'tied a scalar, default value is undef' );
42 # first set, then read
44 is( $scalar, 'fetch me', 'STORE() and FETCH() verified with one test!' );
46 # test DESTROY with an object that signals its destruction
49 tie $scalar, 'Tie::StdScalar', DestroyAction->new();
50 ok( $scalar, 'tied once more' );
51 is( $flag, undef, 'destroy flag not set' );
54 # $scalar out of scope, Tie::StdScalar::DESTROY() called, DestroyAction set flag
55 is( $flag, 1, 'and DESTROY() works' );
57 # we want some noise, and some way to capture it
60 local $SIG{__WARN__} = sub {
64 # Tie::Scalar::TIEHANDLE should find and call TieTest::new and complain
65 is( tie( my $foo, 'TieTest'), 'Fooled you.', 'delegated to new()' );
66 like( $warn, qr/WARNING: calling TieTest->new/, 'caught warning fine' );
68 package DestroyAction;
71 bless( \(my $self), $_[0] );