t/lib/attrhand.t

   1 # Before `make install' is performed this script should be runnable with
   2 # `make test'. After `make install' it should work as `perl test.pl'
   3
   4 ######################### We start with some black magic to print on failure.
   5
   6 BEGIN {
   7     chdir 't' if -d 't';
   8     @INC = '../lib';
   9 }
  10
  11 # Change 1..1 below to 1..last_test_to_print .
  12 # (It may become useful if the test is moved to ./t subdirectory.)
  13
  14 END {print "not ok 1\n" unless $loaded;}
  15 use v5.6.0;
  16 use Attribute::Handlers;
  17 $loaded = 1;
  18
  19 ######################### End of black magic.
  20
  21 # Insert your test code below (better if it prints "ok 13"
  22 # (correspondingly "not ok 13") depending on the success of chunk 13
  23 # of the test code):
  24
  25 sub ok { $::count++; push @::results, [$_[1], $_[0]?"":"not "]; }
  26
  27 END { print "1..$::count\n";
  28       print map "$_->[1]ok $_->[0]\n", sort {$a->[0]<=>$b->[0]} @::results }
  29
  30 package Test;
  31 use warnings;
  32 no warnings 'redefine';
  33
  34 sub UNIVERSAL::Okay :ATTR { ::ok @{$_[4]} }
  35
  36 sub Dokay :ATTR(SCALAR) { ::ok @{$_[4]} }
  37 sub Dokay :ATTR(HASH)   { ::ok @{$_[4]} }
  38 sub Dokay :ATTR(ARRAY)  { ::ok @{$_[4]} }
  39 sub Dokay :ATTR(CODE)   { ::ok @{$_[4]} }
  40
  41 sub Vokay :ATTR(VAR)    { ::ok @{$_[4]} }
  42
  43 sub Aokay :ATTR(ANY)    { ::ok @{$_[4]} }
  44
  45 package main;
  46 use warnings;
  47
  48 my $x1 :Okay(1,1);
  49 my @x1 :Okay(1=>2);
  50 my %x1 :Okay(1,3);
  51 sub x1 :Okay(1,4) {}
  52
  53 my Test $x2 :Dokay(1,5);
  54
  55 package Test;
  56 my $x3 :Dokay(1,6);
  57 my Test $x4 :Dokay(1,7);
  58 sub x3 :Dokay(1,8) {}
  59
  60 my $y1 :Okay(1,9);
  61 my @y1 :Okay(1,10);
  62 my %y1 :Okay(1,11);
  63 sub y1 :Okay(1,12) {}
  64
  65 my $y2 :Vokay(1,13);
  66 my @y2 :Vokay(1,14);
  67 my %y2 :Vokay(1,15);
  68 # BEGIN {eval 'sub y2 :Vokay(0,16) {}; 1' or
  69 ::ok(1,16);
  70 # }
  71
  72 my $z :Aokay(1,17);
  73 my @z :Aokay(1,18);
  74 my %z :Aokay(1,19);
  75 sub z :Aokay(1,20) {};
  76
  77 package DerTest;
  78 use base 'Test';
  79 use warnings;
  80
  81 my $x5 :Dokay(1,21);
  82 my Test $x6 :Dokay(1,22);
  83 sub x5 :Dokay(1,23);
  84
  85 my $y3 :Okay(1,24);
  86 my @y3 :Okay(1,25);
  87 my %y3 :Okay(1,26);
  88 sub y3 :Okay(1,27) {}
  89
  90 package Unrelated;
  91
  92 BEGIN { eval 'my $x7 :Dokay(0,28)' or ::ok(1,28); }
  93 my Test $x8 :Dokay(1,29);
  94 eval 'sub x7 :Dokay(0,30) {}' or ::ok(1,30);
  95
  96
  97 package Tie::Loud;
  98
  99 sub TIESCALAR { ::ok(1,31); bless {}, $_[0] }
 100 sub FETCH { ::ok(1,32); return 1 }
 101 sub STORE { ::ok(1,33); return 1 }
 102
 103 package Tie::Noisy;
 104
 105 sub TIEARRAY { ::ok(1,$_[1]); bless {}, $_[0] }
 106 sub FETCH { ::ok(1,35); return 1 }
 107 sub STORE { ::ok(1,36); return 1 }
 108 sub FETCHSIZE { 100 }
 109
 110 package Tie::Rowdy;
 111
 112 sub TIEHASH { ::ok(1,$_[1]); bless {}, $_[0] }
 113 sub FETCH { ::ok(1,38); return 1 }
 114 sub STORE { ::ok(1,39); return 1 }
 115
 116 package main;
 117
 118 use Attribute::Handlers autotie => {      Other::Loud => Tie::Loud,
 119                                                 Noisy => Tie::Noisy,
 120                                      UNIVERSAL::Rowdy => Tie::Rowdy,
 121                                    };
 122
 123 my Other $loud : Loud;
 124 $loud++;
 125
 126 my @noisy : Noisy(34);
 127 $noisy[0]++;
 128
 129 my %rowdy : Rowdy(37);
 130 $rowdy{key}++;