1#!perl -I.. 2 3# Readonly scalar tests 4 5use strict; 6use Test::More tests => 12; 7 8# Find the module (1 test) 9BEGIN {use_ok('Readonly'); } 10 11sub expected 12{ 13 my $line = shift; 14 $@ =~ s/\.$//; # difference between croak and die 15 return "Modification of a read-only value attempted at " . __FILE__ . " line $line\n"; 16} 17 18use vars qw/$s1 $s2/; 19my ($ms1, $ms2); 20 21# creation (4 tests) 22eval {Readonly::Scalar $s1 => 13}; 23is $@ => '', 'Create a global scalar'; 24eval {Readonly::Scalar $ms1 => 31}; 25is $@ => '', 'Create a lexical scalar'; 26eval {Readonly::Scalar $s2 => undef}; 27is $@ => '', 'Create an undef global scalar'; 28eval 'Readonly::Scalar $ms2'; # must be eval string because it's a compile-time error 29like $@ => qr/^Not enough arguments for Readonly::Scalar/, 'Try w/o args'; 30 31# fetching (4 tests) 32is $s1 => 13, 'Fetch global'; 33is $ms1 => 31, 'Fetch lexical'; 34ok !defined $s2, 'Fetch undef global'; 35ok !defined $ms2, 'Fetch undef lexical'; 36 37# storing (2 tests) 38eval {$s1 = 7}; 39is $@ => expected(__LINE__-1), 'Error setting global'; 40is $s1 => 13, 'Readonly global value unchanged'; 41 42# untie (1 test) 43SKIP:{ 44 skip "Can't catch 'untie' until perl 5.6", 1 if $] < 5.006; 45 skip "Scalars not tied: XS in use", 1 if $Readonly::XSokay; 46 eval {untie $ms1}; 47 is $@ => expected(__LINE__-1), 'Untie'; 48 } 49