#!/usr/bin/perl -w
# $Id: 22clone.t 1511 2010-08-21 23:24:49Z ian $

# clone.t
#
# Ensure Class::Declare::new() clones objects correctly when called as an
# instance method.

use strict;
use Test::More  tests => 42;
use Test::Exception;

# define a Class::Declare package
package Test::Clone::One;

use strict;
use base qw( Class::Declare );

# declare all types of attributes
__PACKAGE__->declare( class      => { my_class      => \1 } ,
                      static     => { my_static     => \2 } ,
            restricted => { my_restricted => \3 } ,
            public     => { my_public     => \4 } ,
            private    => { my_private    => \5 } ,
            protected  => { my_protected  => \6 } );

# define methods for comparing class and instance attributes
sub cmp_class
{
  my  $self   = __PACKAGE__->class( shift );
  my  $attribute  = shift;
  my  ( $a , $b ) = @_;

  # class attributes should have the rame reference and the same value
  return (       $a->$attribute   ==    $b->$attribute
           && ${ $a->$attribute } == ${ $b->$attribute } );
} # cmp_class()

sub cmp_instance
{
  my  $self   = __PACKAGE__->class( shift );
  my  $attribute  = shift;
  my  ( $a , $b ) = @_;

  # instance attributes should be cloned (i.e. references should be
  # different, but the values should be the same
  return (       $a->$attribute   !=    $b->$attribute
           && ${ $a->$attribute } == ${ $b->$attribute } );
} # cmp_instance()

1;

# return to main to resume testing
package main;

# create an instance of the test class and the clone it
my  $class  = 'Test::Clone::One';
my  $object = $class->new;
# make sure cloning works
my  $clone;
lives_ok { $clone = $object->new } "CODEREF new() execution succeeds";

# make sure they are different objects
ok( $clone != $object , "clone and object are not the same reference" );
ok( ref( $clone ) , "clone is a reference" );
ok( ref( $clone ) eq ref( $object ) ,
    "clone and object represent the same class" );

# OK, now compare the attribute values for these objects
#   - start with the class attributes
ok( $class->cmp_class( "my_" . $_ , $object , $clone ) ,
    "$_ attributes cloned correctly" )
    foreach ( qw( class static restricted ) );

#   - now the object attributes
ok( $class->cmp_instance( "my_" . $_ , $object , $clone ) ,
    "$_ attributes cloned correctly" )
    foreach ( qw( public private protected ) );

# NB: CODEREFs cannot be cloned, so let's make sure they are copied
# correctly

# define a new test package with CODEREFs as attribute values
package Test::Clone::Two;

use strict;
use base qw( Class::Declare );

# declare a random constant
use constant  RANDOM  => rand;

# declare all types of attributes
__PACKAGE__->declare( class      => { my_class      => sub { RANDOM + 1 } } ,
                      static     => { my_static     => sub { RANDOM + 2 } } ,
            restricted => { my_restricted => sub { RANDOM + 3 } } ,
            public     => { my_public     => sub { RANDOM + 4 } } ,
            private    => { my_private    => sub { RANDOM + 5 } } ,
            protected  => { my_protected  => sub { RANDOM + 6 } } );

# define methods for comparing class and instance attributes
sub cmp
{
  my  $self   = __PACKAGE__->class( shift );
  my  $attribute  = shift;
  my  ( $a , $b ) = @_;

  # for CODEREFs, class and instance attributes should have the same
  # reference and hence return the same value
  return (    $a->$attribute     == $b->$attribute
           && $a->$attribute->() == $b->$attribute->() );
} # cmp()

1;

# return to main to resume testing
package main;

# create an instance of the test class and the clone it
  $class  = 'Test::Clone::Two';
  $object = $class->new;
# make sure cloning works
lives_ok { $clone = $object->new }
         "new() execution succeeds with COEDREF attributes";

# make sure they are different objects
ok( $clone != $object , "clone and object are not the same reference" );
ok( ref( $clone ) , "clone is a reference" );
ok( ref( $clone ) eq ref( $object ) ,
    "clone and object represent the same class" );

# OK, now compare the attribute values for these objects
#   - start with the class attributes
ok( $class->cmp( "my_" . $_ , $object , $clone ) ,
    "$_ attributes cloned correctly" )
    foreach ( qw( class static restricted ) );

#   - now the object attributes
ok( $class->cmp( "my_" . $_ , $object , $clone ) ,
    "$_ attributes cloned correctly" )
    foreach ( qw( public private protected ) );

#
# need to ensure cloning will honour public attribute values passed to the
# constructor
#

# first, test with Test::Clone::One
  $class  = 'Test::Clone::One';
  $object = $class->new;
lives_ok { $clone = $object->new( my_public => \7 ) }
         "cloning accepts public attributes";

# make sure they are different objects
ok( $clone != $object , "clone and object are not the same reference" );
ok( ref( $clone ) , "clone is a reference" );
ok( ref( $clone ) eq ref( $object ) ,
    "clone and object represent the same class" );

# OK, now compare the attribute values for these objects
#   - start with the class attributes
ok( $class->cmp_class( "my_" . $_ , $object , $clone ) ,
    "$_ attributes cloned correctly" )
    foreach ( qw( class static restricted ) );

#   - now the object attributes (except the public attribute)
ok( $class->cmp_instance( "my_" . $_ , $object , $clone ) ,
    "$_ attributes cloned correctly" )
    foreach ( qw( private protected ) );

#   - make sure the public attributes are different
ok(   $object->my_public    !=    $clone->my_public ,
    "public attribute references not cloned when set in constructor" );
ok( ${ $object->my_public } != ${ $clone->my_public } ,
    "public attribute values not cloned when set in constructor" );


# make sure cloning honours multiple inheritance

package Test::Clone::Three;

use strict;
use base qw( Test::Clone::One );

__PACKAGE__->declare( public => { my_instance => \42 } );

1;

# return to main to resume testing
package main;

  $class  = 'Test::Clone::Three';
  $object = $class->new;
# make sure cloning works
lives_ok { $clone = $object->new } "cloning with inheritance succeeds";

# make sure they are different objects
ok( $clone != $object , "clone and object are not the same reference" );
ok( ref( $clone ) , "clone is a reference" );
ok( ref( $clone ) eq ref( $object ) ,
    "clone and object represent the same class" );

# OK, now compare the attribute values for these objects
#   - start with the class attributes
ok( $class->cmp_class( "my_" . $_ , $object , $clone ) ,
    "$_ attributes cloned correctly" )
    foreach ( qw( class static restricted ) );

#   - now the object attributes (except the public attribute)
ok( $class->cmp_instance( "my_" . $_ , $object , $clone ) ,
    "$_ attributes cloned correctly" )
    foreach ( qw( public private protected instance ) );