myclone.pl

use Test;
use MONKEY_TYPING;

augment class Cool {
    method clone(*%twiddles) {
        my $cloned := nqp::clone(nqp::decont(self));
        for self.^attributes() -> $attr {
            my $name := $attr.name;
            my $package := $attr.package;
            unless nqp::objprimspec($attr.type) {
                my $attr_val := nqp::getattr($cloned, $package, $name);
                nqp::bindattr($cloned, $package, $name, nqp::clone($attr_val.VAR))
                    if nqp::iscont($attr_val) || nqp::isconcrete($attr_val.VAR);
            }
            my $acc_name := $name.substr(2);
            if $attr.has-accessor && %twiddles.exists($acc_name) {
                nqp::getattr($cloned, $package, $name) = %twiddles{$acc_name};
            }
        }
        $cloned
    }
}

my ($p, $q);
$p = 'a' ~~ /$<foo>='a'/;

# previously it was timeout on Rakudo
lives_ok { $q = $p.clone }, 'Match object can be cloned';

is ~$q{'foo'}, 'a', 'cloned Match object retained named capture value';


my class ArrTest is Cool { has @.array; }

my $a1 = ArrTest.new(:array<a b>);
my $a2 = $a1.clone(:array<c d>);
is_deeply $a1.array, ['a', 'b'], 'original object has its original array';
is_deeply $a2.array, ['c', 'd'], 'cloned object has the newly-provided array';