#!/usr/bin/perl -w

use strict;
use Test::More tests => 9 + 1;
use Test::NoWarnings;

package SimpleString;

use overload::substr substr => \&_substr;

sub new
{
   my $class = shift;
   my ( $str ) = @_;
   return bless {
      str => $str,
   }, $class;
}

my @substr_args;
my $substr_return;
sub _substr
{
   my $self = shift;
   @substr_args = @_;

   return $substr_return;
}

package main;

my $str = SimpleString->new( "Hello, world" );
my $s;

$substr_return = "Hello";

$s = substr( $str, 0, 5 );
is( $s, "Hello", 'substr extraction' );

is_deeply( \@substr_args,
           [ 0, 5 ],
           '@args to substr extraction' );

substr( $str, 0, 5, "Goodbye" );
is_deeply( \@substr_args,
           [ 0, 5, "Goodbye" ],
           '@args to substr replacement' );

substr( $str, 9, 0 ) = "cruel ";
is_deeply( \@substr_args,
           [ 9, 0, "cruel " ],
           '@args to substr replacment by lvalue' );

# Test an OPf_MOD call being fetched
sub identity { return $_[0] }

$substr_return = "Result";
$s = identity( substr( $str, 0, 6 ) );
is( $s, "Result", 'substr result by OPf_MOD get' );
is_deeply( \@substr_args,
           [ 0, 6 ],
           '@args to OPf_MOD get' );

# Now lets just assert that non-string values work successfully
$substr_return = [ "return" ];
$s = substr( $str, 1, 2 );
is_deeply( $s,
           [ "return" ],
           'non-string substr extraction' );

substr( $str, 3, 4, [ "replace call" ] );
is_deeply( \@substr_args,
           [ 3, 4, [ "replace call" ] ],
           '@args to non-string substr replacement' );

substr( $str, 5, 6 ) = [ "replace lvalue" ];
is_deeply( \@substr_args,
           [ 5, 6, [ "replace lvalue" ] ],
           '@args to non-string substr replacement by lvalue' );
