t/lib/access.t

   1 #!./perl
   2
   3 BEGIN {
   4     chdir 't' if -d 't';
   5     @INC = '../lib';
   6 }
   7
   8 $| = 1;
   9 print "1..19\n";
  10
  11 my $t = 1;
  12
  13 sub ok
  14 {
  15  my $val = shift;
  16  if ($val)
  17   {
  18    print "ok $t\n";
  19   }
  20  else
  21   {
  22    my ($pack,$file,$line) = caller;
  23    print "not ok $t # $file:$line\n";
  24   }
  25  $t++;
  26 }
  27
  28 my %hash = ( one => 1, two => 2);;
  29 ok(!access::readonly(%hash));
  30
  31 ok(!access::readonly(%hash,1));
  32
  33 ok(!access::readonly($hash{two},1));
  34
  35 eval { $hash{'three'} = 3 };
  36 #warn "$@";
  37 ok($@ =~ /^Attempt to access to key 'three' in fixed hash/);
  38
  39 eval { print "# oops"  if $hash{'four'}};
  40 #warn "$@";
  41 ok($@ =~ /^Attempt to access to key 'four' in fixed hash/);
  42
  43 eval { $hash{"\x{2323}"} = 3 };
  44 #warn "$@";
  45 ok($@ =~ /^Attempt to access to key '(.*)' in fixed hash/);
  46 #ok(ord($1) == 0x2323);
  47
  48 eval { delete $hash{'two'}};
  49 #warn "$@";
  50 ok($@);
  51
  52 eval { delete $hash{'one'}};
  53 ok(not $@);
  54
  55 ok($hash{two} == 2);
  56
  57 eval { delete $hash{'four'}};
  58 #warn "$@";
  59 ok($@ =~ /^Attempt to access to key 'four' in fixed hash/);
  60
  61 ok(not exists $hash{'one'});
  62
  63 ok(!exists $hash{'three'});
  64
  65 ok(access::readonly(%hash,0));
  66
  67 ok(!access::readonly(%hash));
  68
  69 my $scalar = 1;
  70 ok(!access::readonly($scalar));
  71
  72 ok(!access::readonly($scalar,1));
  73
  74 eval { $scalar++ };
  75 #warn $@;
  76 ok($@ =~ /^Modification of a read-only value attempted/);
  77
  78 ok(access::readonly($scalar,0));
  79
  80 ok(!access::readonly($scalar));
  81
  82