# classes for 015.freeze_thaw test. updated version of Chris's dd_freeze_thaw.t
# tests freeze/thaw behavior of our modified Dumper

########################################
## base package for test classes. declares attributes. 
## initializes 'fresh' and various ref attributes
########################################
package root;
use strict;
use base qw(Class::AutoClass);
use vars qw(@AUTO_ATTRIBUTES %DEFAULTS);
@AUTO_ATTRIBUTES=qw(name fresh fill freeze_thaw freeze freeze2thaw thaw nada);
%DEFAULTS=(fresh=>'fresh',fill=>0);
Class::AutoClass::declare;

sub _init_self {
  my($self,$class,$args)=@_;
  return unless $class eq __PACKAGE__; # to prevent subclasses from re-running this
  my $name=$self->name;
  $self->set(freeze_thaw=>new freeze_thaw(name=>"from $name"),
	     freeze=>new freeze(name=>"from $name"),
	     freeze2thaw=>new freeze2thaw(name=>"from $name"),
	     thaw=>new thaw(name=>"from $name"),
	     nada=>new nada(name=>"from $name"),) if $self->fill;
}
########################################
## freeze_thaw package - has DUMPER_freeze, DUMPER_thaw
########################################
package freeze_thaw;
use strict;
use base qw(root);
use Test::More;

# NG 10-01-01: modified to leave $self unchanged and return desired new value
sub DUMPER_freeze {
  my($self)=@_;
  # note(">>> DUMPER_freeze");
  my $copy=bless {},ref $self;
  # force shallow copy
  %$copy=%$self;
  $copy->fresh('nope. frozen and thawed');
  return $copy;
}
sub DUMPER_thaw {
  my($self)=@_;
  # note("<<< DUMPER_thaw");
  return $self;
}
########################################
## freeze package - has DUMPER_freeze, no DUMPER_thaw
########################################
package freeze;
use strict;
use base qw(root);
use Test::More;

# NG 10-01-01: modified to leave $self unchanged and return desired new value
sub DUMPER_freeze {
  my($self)=@_;
  # note(">>> DUMPER_freeze");
  my $copy=bless {},ref $self;
  # force shallow copy
  %$copy=%$self;
  $copy->fresh('nope. frozen and thawed');
  return $copy;
}
########################################
## freeze2thaw package - has DUMPER_freeze (emits 'thaw' object), no DUMPER_thaw
########################################
package freeze2thaw;
use strict;
use base qw(root);
use Test::More;

# NG 10-01-01: modified to leave $self unchanged and return desired new value
sub DUMPER_freeze {
  my($self)=@_;
  # note(">>> DUMPER_freeze");
  my $copy=bless {},'thaw';
  # force shallow copy
  %$copy=%$self;
  $copy->fresh('nope. frozen and thawed');
  return $copy;
}
########################################
## thaw package - no DUMPER_freeze, yes DUMPER_thaw
########################################
package thaw;
use strict;
use base qw(root);
use Test::More;

sub DUMPER_thaw {
  my($self)=@_;
  # note("<<< DUMPER_thaw");
  return $self;
}

########################################
## nada package  (no DUMPER_freeze, DUMPER_thaw method)
########################################
package nada;
use strict;
use base qw(root);
use Test::More;

1;