lib/Attribute/Handlers/t/multi.t

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