Server IP : 23.254.227.96 / Your IP : 216.73.216.7 Web Server : Apache/2.4.62 (Unix) OpenSSL/1.1.1k System : Linux hwsrv-1277026.hostwindsdns.com 4.18.0-477.13.1.el8_8.x86_64 #1 SMP Tue May 30 14:53:41 EDT 2023 x86_64 User : viralblo ( 1001) PHP Version : 8.1.31 Disable Function : NONE MySQL : OFF | cURL : ON | WGET : ON | Perl : ON | Python : OFF | Sudo : ON | Pkexec : ON Directory : /usr/share/doc/perl-Class-Method-Modifiers/t/ |
Upload File : |
use strict; use warnings; use Test::More 0.88; use if $ENV{AUTHOR_TESTING}, 'Test::Warnings'; use Test::Fatal; { package WithLvalue; my $f; sub lvalue_method :lvalue { $f } sub other_method { 1 } my @array; sub array_lvalue :lvalue { @array } } { package Around; use Class::Method::Modifiers; our @ISA = qw(WithLvalue); around lvalue_method => sub :lvalue { my $orig = shift; $orig->(@_); }; my $d; around other_method => sub :lvalue { $d; }; around array_lvalue => sub :lvalue { $_[0]->(@_[1..$#_]); }; } Around->lvalue_method = 1; is(Around->lvalue_method, 1, 'around on an lvalue attribute is maintained'); Around->other_method = 2; is(Around->other_method, 2, 'around adding an lvalue attribute works'); (Around->array_lvalue) = (1,2); is_deeply([WithLvalue->array_lvalue], [1,2], 'around on array lvalue attribute works'); { package Before; use Class::Method::Modifiers; our @ISA = qw(WithLvalue); before lvalue_method => sub {}; } Before->lvalue_method = 3; is(Before->lvalue_method, 3, 'before maintains lvalue attribute'); { package After; use Class::Method::Modifiers; our @ISA = qw(WithLvalue); after lvalue_method => sub {}; after array_lvalue => sub {}; } After->lvalue_method = 4; is(After->lvalue_method, 4, 'after maintains lvalue attribute'); { local $TODO = "can't apply after to array lvalue method"; is exception { (After->array_lvalue) = (3,4) }, undef, 'assigning to array lvalue attribute causes no errors'; is_deeply([After->array_lvalue], [3,4], 'after array lvalue attribute sets values'); } done_testing;