1N/A#!./perl
1N/A
1N/ABEGIN {
1N/A chdir 't' if -d 't';
1N/A @INC = '../lib';
1N/A}
1N/A
1N/A# this must come before main, or tests will fail
1N/Apackage TieTest;
1N/A
1N/Ause Tie::Scalar;
1N/Ause vars qw( @ISA );
1N/A@ISA = qw( Tie::Scalar );
1N/A
1N/Asub new { 'Fooled you.' }
1N/A
1N/Apackage main;
1N/A
1N/Ause vars qw( $flag );
1N/Ause Test::More tests => 13;
1N/A
1N/Ause_ok( 'Tie::Scalar' );
1N/A
1N/A# these are "abstract virtual" parent methods
1N/Afor my $method qw( TIESCALAR FETCH STORE ) {
1N/A eval { Tie::Scalar->$method() };
1N/A like( $@, qr/doesn't define a $method/, "croaks on inherited $method()" );
1N/A}
1N/A
1N/A# the default value is undef
1N/Amy $scalar = Tie::StdScalar->TIESCALAR();
1N/Ais( $$scalar, undef, 'used TIESCALAR, default value is still undef' );
1N/A
1N/A# Tie::StdScalar redirects to TIESCALAR
1N/A$scalar = Tie::StdScalar->new();
1N/Ais( $$scalar, undef, 'used new(), default value is still undef' );
1N/A
1N/A# this approach should work as well
1N/Atie $scalar, 'Tie::StdScalar';
1N/Ais( $$scalar, undef, 'tied a scalar, default value is undef' );
1N/A
1N/A# first set, then read
1N/A$scalar = 'fetch me';
1N/Ais( $scalar, 'fetch me', 'STORE() and FETCH() verified with one test!' );
1N/A
1N/A# test DESTROY with an object that signals its destruction
1N/A{
1N/A my $scalar = 'foo';
1N/A tie $scalar, 'Tie::StdScalar', DestroyAction->new();
1N/A ok( $scalar, 'tied once more' );
1N/A is( $flag, undef, 'destroy flag not set' );
1N/A}
1N/A
1N/A# $scalar out of scope, Tie::StdScalar::DESTROY() called, DestroyAction set flag
1N/Ais( $flag, 1, 'and DESTROY() works' );
1N/A
1N/A# we want some noise, and some way to capture it
1N/Ause warnings;
1N/Amy $warn;
1N/Alocal $SIG{__WARN__} = sub {
1N/A $warn = $_[0];
1N/A};
1N/A
1N/A# Tie::Scalar::TIEHANDLE should find and call TieTest::new and complain
1N/Ais( tie( my $foo, 'TieTest'), 'Fooled you.', 'delegated to new()' );
1N/Alike( $warn, qr/WARNING: calling TieTest->new/, 'caught warning fine' );
1N/A
1N/Apackage DestroyAction;
1N/A
1N/Asub new {
1N/A bless( \(my $self), $_[0] );
1N/A}
1N/A
1N/Asub DESTROY {
1N/A $main::flag = 1;
1N/A}