#!/usr/bin/perl -w

use strict;
use warnings;

use Test::More;
plan tests => 27;

use Perl6::Container::Scalar;
use Perl6::Value;

can_ok('Scalar', 'new');
ok(Scalar->isa('Perl6::Object'), '... Scalar isa Perl6::Object');

{
    my $n = Scalar->new;
    $n->store( Num->new( '$.unboxed' => 3.3 ) );
  
    isa_ok($n, 'Scalar');
    can_ok($n, 'fetch');
    isa_ok($n->fetch, 'Num', '... fetch Num');
    is($n->unboxed, 3.3, '... got the unboxed value');
    is($n->defined->str->unboxed, bool::true, '... defined() is true');

    # .bind($other_scalar)
    my $m = Scalar->new;
    $m->bind( $n );
    is($n->unboxed, 3.3, '... got the unboxed value from the other Scalar');
    $m->increment;
    is($m->unboxed, 4.3, '... increment both Scalars');
    is($n->unboxed, 4.3, '... increment both Scalars');
    $n->bind( Scalar->new );
    $m->increment;
    is($m->unboxed, 5.3, '... unbind, increment only one Scalar');
    is($n->unboxed, undef, '... Scalar didn\'t change');
}

{
    # access control

    # NOTE - test removed - this is now controlled by a trait
    # See: t/trait.t
    # my $n = Scalar->new;
    # $n->access('ro');
    # $n->store( Num->new( '$.unboxed' => 3.3 ) );
    # is( $n->unboxed, 3.3, '... stored a value in a read only container');

    # clone
    # my $m = $n->clone;
;}

{
    # TODO - ref
    # my $class = $n->ref;
    # warn 'class '. $class. " ". ref($class);
    # warn 'class ident '. $class->identifier;
    # XXX is($n->ref->name, 'Num', '... get the class name');

    # warn $n->ref;  # Perl6::Class=HASH(0x8269888)

    # warn $n->ref->id;
    # warn $n->ref->identifier;
    # warn $n->ref->name;
    # warn $n->ref->version;
    # warn $n->ref->class;
    # warn $n->ref->meta;

    my $n = Scalar->new;
    $n->store( Num->new( '$.unboxed' => 3.3 ) );

    my $n2 = $n->ref->new( '$.unboxed' => 'xxx' );
    isa_ok($n2, 'Num', '.ref() is a reference to the "value" class');

    # undefine
    $n->undefine;
    is($n->defined->str->unboxed, bool::false, '... defined() is false');
}

{
    my $n = Scalar->new();
  
    isa_ok($n, 'Scalar', 'empty Scalar');
    can_ok($n, 'fetch');
    is($n->unboxed, undef, '... type is undef');
    is($n->perl->unboxed, '\\undef', '... .perl is undef');
    is($n->defined->str->unboxed, bool::false, '... defined() is false');
    $n->increment;
    is($n->unboxed, 1, '... increment defines');

    $n->increment;
    is($n->unboxed, 2, '... increment Int');

    # TODO - ref of undef
}

{  
    # dispatching methods to the cell Value ?
    
    my $p = Scalar->new();
    $p->store( Pair->new( 
                   '$.key' => Str->new( '$.unboxed' => 'a' ),
                   '$.value' =>   Num->new( '$.unboxed' => 3.3 ) 
                ) );
    is( $p->key->unboxed, 'a', '... auto dereference and retrieve Pair key' );
    is( $p->value->unboxed, 3.3, '... auto dereference and retrieve Pair value' );
    $p->value( Num->new( '$.unboxed' => 7 ) );
    is( $p->value->unboxed, 7, '... auto dereference and store Pair value' );
}

{  
    # store unboxed value
    
    my $p = Scalar->new();
    $p->store( 5 );
    is( $p->fetch, 5, '... store/fetch unboxed value' );
}

{  
    # tie
    
    # NOTE - test removed - this is now controlled by a trait
    # See: t/trait.t
    # sub Thing::new { bless {}, 'Thing' } 
    # sub Thing::store { $_[0]{v} = $_[1] }
    # sub Thing::fetch { $_[0]{v} }

    # my $t = Thing->new();

    # my $s = Scalar->new();

    # $s->tie( $t );   # dies ok

    # $s->set_tieable;
    # $s->tie( $t );

    # $s->store( 5 );
    # is( $s->fetch, 5, '... store/fetch tied value' );

    # $s->untie;
    # is( $s->fetch, undef, '... untie' );
;}

{  
    # id

    my $s = Scalar->new();
    my $t = Scalar->new();

    isnt( $s->id, $t->id, 'id is different for each Scalar');

    $t->bind( $s );
    is( $s->id, $t->id, '... same id for binded Scalars');
}