#!/usr/bin/perl
use strict;
use warnings;
use Test::More tests => 22;
use Test::Exception;
use Carp 'confess';
use Perl6::MetaModel;
=pod
This test checks that a parameterized class like Array can
handle nested parameterized instnaces of itself. Such as
- Array of Array of Int
=cut
my $Array = class 'Array' => [ '::T' ] => sub {
my %p = @_;
# fetch my generic parameter
my $T = $p{'::T'};
$::CLASS->superclasses([ $::Object ]);
$::CLASS->name('Array[' . $T->name . ']');
$::CLASS->add_attribute('@:values' => ::make_attribute('@:values'));
$::CLASS->add_method('STORE' => ::make_method(sub {
my ($self, $index, $value) = @_;
($value->isa($T->name) || $value->does($T))
|| confess "Incorrect Type";
::opaque_instance_attr($self => '@:values')->[$index] = $value;
}));
$::CLASS->add_method('FETCH' => ::make_method(sub {
my ($self, $index) = @_;
::opaque_instance_attr($::SELF => '@:values')->[$index];
}));
};
my $Int = class 'Int' => {
is => [ $::Object ],
attributes => [ '$:num' ],
methods => {
'num' => sub { _('$:num') }
}
};
isa_ok($Int, 'Int');
my $Str = class 'Str' => { is => [ $::Object ] };
isa_ok($Str, 'Str');
my $ArrayOfInt = $Array->('::T' => $Int);
isa_ok($ArrayOfInt, 'Array[Int]');
my $ArrayOfArrayOfInt = $Array->('::T' => $ArrayOfInt);
isa_ok($ArrayOfArrayOfInt, 'Array[Array[Int]]');
# now do something, and see what happens
my $array_of_int = $ArrayOfInt->new();
isa_ok($array_of_int, 'Array[Int]');
lives_ok {
$array_of_int->STORE(0, $Int->new('$:num' => 1));
$array_of_int->STORE(1, $Int->new('$:num' => 2));
$array_of_int->STORE(2, $Int->new('$:num' => 3));
} '... STORE-ing values in Array[Int] worked';
isa_ok($array_of_int->FETCH(0), 'Int');
isa_ok($array_of_int->FETCH(1), 'Int');
isa_ok($array_of_int->FETCH(2), 'Int');
is($array_of_int->FETCH(0)->num, 1, '... got the number we expected');
is($array_of_int->FETCH(1)->num, 2, '... got the number we expected');
is($array_of_int->FETCH(2)->num, 3, '... got the number we expected');
dies_ok {
$array_of_int->STORE(3, $Str->new());
} '... STORE-ing bad values in Array[Int] failed (as expected)';
my $array_of_array_of_int = $ArrayOfArrayOfInt->new();
isa_ok($array_of_array_of_int, 'Array[Array[Int]]');
dies_ok {
$array_of_array_of_int->STORE(0, $Int->new('$:num' => 1));
} '... STORE-ing bad values in Array[Array[Int]] failed (as expected)';
dies_ok {
$array_of_array_of_int->STORE(0, $Str->new());
} '... STORE-ing bad values in Array[Array[Int]] failed (as expected)';
lives_ok {
$array_of_array_of_int->STORE(0, $array_of_int);
} '... STORE-ing the correct value-type in Array[Array[Int]] worked';
is($array_of_array_of_int->FETCH(0)->FETCH(0)->num, 1, '... got the number we expected');
is($array_of_array_of_int->FETCH(0)->FETCH(1)->num, 2, '... got the number we expected');
is($array_of_array_of_int->FETCH(0)->FETCH(2)->num, 3, '... got the number we expected');
lives_ok {
$array_of_array_of_int->FETCH(0)->STORE(3, $Int->new('$:num' => 4));
} '... STORE-ing values in Array[Int] through Array[Array[Int]] worked';
is($array_of_array_of_int->FETCH(0)->FETCH(3)->num, 4, '... got the number we expected');