1#!perl -I.. 2 3# Readonly array tests 4 5use strict; 6use Test::More tests => 23; 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/@a1 @a2/; 19my @ma1; 20 21# creation (3 tests) 22eval 'Readonly::Array @a1;'; 23is $@ =>'', 'Create empty global array'; 24eval 'Readonly::Array @ma1 => ();'; 25is $@ => '', 'Create empty lexical array'; 26eval 'Readonly::Array @a2 => (1,2,3,4,5);'; 27is $@ => '', 'Create global array'; 28 29# fetching (3 tests) 30ok !defined($a1[0]), 'Fetch global'; 31is $a2[0] => 1, 'Fetch global'; 32is $a2[-1] => 5, 'Fetch global'; 33 34# fetch size (3 tests) 35is scalar(@a1) => 0, 'Global size (zero)'; 36is scalar(@ma1) => 0, 'Lexical size (zero)'; 37is $#a2 => 4, 'Global last element (nonzero)'; 38 39# store (2 tests) 40eval {$ma1[0] = 5;}; 41is $@ => expected(__LINE__-1), 'Lexical store'; 42eval {$a2[3] = 4;}; 43is $@ => expected(__LINE__-1), 'Global store'; 44 45# storesize (1 test) 46eval {$#a1 = 15;}; 47is $@ => expected(__LINE__-1), 'Change size'; 48 49# extend (1 test) 50eval {$a1[77] = 88;}; 51is $@ => expected(__LINE__-1), 'Extend'; 52 53# exists (2 tests) 54SKIP: { 55 skip "Can't do exists on array until Perl 5.6", 2 if $] < 5.006; 56 57 eval 'ok(exists $a2[4], "Global exists")'; 58 eval 'ok(!exists $ma1[4], "Lexical exists")'; 59 } 60 61# clear (1 test) 62eval {@a1 = ();}; 63is $@ => expected(__LINE__-1), 'Clear'; 64 65# push (1 test) 66eval {push @ma1, -1;}; 67is $@ => expected(__LINE__-1), 'Push'; 68 69# unshift (1 test) 70eval {unshift @a2, -1;}; 71is $@ => expected(__LINE__-1), 'Unshift'; 72 73# pop (1 test) 74eval {pop (@a2);}; 75is $@ => expected(__LINE__-1), 'Pop'; 76 77# shift (1 test) 78eval {shift (@a2);}; 79is $@ => expected(__LINE__-1), 'shift'; 80 81# splice (1 test) 82eval {splice @a2, 0, 1;}; 83is $@ => expected(__LINE__-1), 'Splice'; 84 85# untie (1 test) 86SKIP: { 87 skip "Can't catch untie until Perl 5.6", 1 if $] <= 5.006; 88 eval {untie @a2;}; 89 is $@ => expected(__LINE__-1), 'Untie'; 90 } 91