FM / general

/usr/share/doc/perl-Readonly/t/general

Name	Size	Mode	Actions
array.t	2050	0644	edit dl rm
clone.t	1420	0644	edit dl rm
deepa.t	1220	0644	edit dl rm
deeph.t	1266	0644	edit dl rm
deeps.t	1766	0644	edit dl rm
docs.t	2335	0644	edit dl rm
export.t	191	0644	edit dl rm
hash.t	1691	0644	edit dl rm
readonly.t	2247	0644	edit dl rm
reassign.t	3108	0644	edit dl rm
scalar.t	1318	0644	edit dl rm
tie.t	616	0644	edit dl rm

Edit: /usr/share/doc/perl-Readonly/t/general/array.t (2050B)

#!/usr/bin/perl -I../../lib

# Readonly array tests

use strict;
use Test::More tests => 23;

# Find the module (1 test)
BEGIN {use_ok('Readonly'); }

sub expected
{
    my $line = shift;
    $@ =~ s/\.$//;   # difference between croak and die
    return "Modification of a read-only value attempted at " . __FILE__ . " line $line\n";
}

use vars qw/@a1 @a2/;
my @ma1;

# creation (3 tests)
eval 'Readonly::Array @a1;';
is $@ =>'', 'Create empty global array';
eval 'Readonly::Array @ma1 => ();';
is $@ => '', 'Create empty lexical array';
eval 'Readonly::Array @a2 => (1,2,3,4,5);';
is $@ => '', 'Create global array';

# fetching (3 tests)
ok !defined($a1[0]), 'Fetch global';
is $a2[0]  => 1, 'Fetch global';
is $a2[-1] => 5, 'Fetch global';

# fetch size (3 tests)
is scalar(@a1)  => 0, 'Global size (zero)';
is scalar(@ma1) => 0, 'Lexical size (zero)';
is $#a2 => 4, 'Global last element (nonzero)';

# store (2 tests)
eval {$ma1[0] = 5;};
is $@ => expected(__LINE__-1), 'Lexical store';
eval {$a2[3] = 4;};
is $@ => expected(__LINE__-1), 'Global store';

# storesize (1 test)
eval {$#a1 = 15;};
is $@ => expected(__LINE__-1), 'Change size';

# extend (1 test)
eval {$a1[77] = 88;};
is $@ => expected(__LINE__-1), 'Extend';

# exists (2 tests)
SKIP: {
	skip "Can't do exists on array until Perl 5.6", 2  if $] < 5.006;

eval 'ok(exists $a2[4], "Global exists")';
	eval 'ok(!exists $ma1[4], "Lexical exists")';
	}

# clear (1 test)
eval {@a1 = ();};
is $@ => expected(__LINE__-1), 'Clear';

# push (1 test)
eval {push @ma1, -1;};
is $@ => expected(__LINE__-1), 'Push';

# unshift (1 test)
eval {unshift @a2, -1;};
is $@ => expected(__LINE__-1), 'Unshift';

# pop (1 test)
eval {pop (@a2);};
is $@ => expected(__LINE__-1), 'Pop';

# shift (1 test)
eval {shift (@a2);};
is $@ => expected(__LINE__-1), 'shift';

# splice (1 test)
eval {splice @a2, 0, 1;};
is $@ => expected(__LINE__-1), 'Splice';

# untie (1 test)
SKIP: {
	skip "Can't catch untie until Perl 5.6", 1  if $] <= 5.006;
	eval {untie @a2;};
	is $@ => expected(__LINE__-1), 'Untie';
	}

cmd: