dist/ExtUtils-ParseXS/t/516-t-clone.t

   1 #!/usr/bin/perl
   2 use strict;
   3 use warnings;
   4
   5 use Test::More tests => 6;
   6 use ExtUtils::Typemaps;
   7
   8 # Test that cloning typemap object shallowly or deeply both
   9 # works as designed.
  10
  11 SCOPE: {
  12   my $map = ExtUtils::Typemaps->new();
  13   $map->add_typemap(ctype => 'unsigned int', xstype => 'T_UV');
  14   $map->add_inputmap(xstype => 'T_UV', code => '$var = ($type)SvUV($arg);');
  15   $map->add_outputmap(xstype => 'T_UV', code => 'sv_setuv($arg, (UV)$var);');
  16
  17   $map->add_typemap(ctype => 'int', xstype => 'T_IV');
  18   $map->add_inputmap(xstype => 'T_IV', code => '$var = ($type)SvIV($arg);');
  19   $map->add_outputmap(xstype => 'T_IV', code => 'sv_setiv($arg, (IV)$var);');
  20
  21   my $clone = $map->clone;
  22   my $shallow = $map->clone(shallow => 1);
  23
  24   is_deeply($clone, $map, "Full clone equivalent to original");
  25   is_deeply($shallow, $map, "Shallow clone equivalent to original");
  26
  27   $map->add_typemap(ctype => "foo", xstype => "bar");
  28
  29   ok(!$clone->get_typemap(ctype => 'foo'), "New typemap not propagated to full clone");
  30   ok(!$shallow->get_typemap(ctype => 'foo'), "New typemap not propagated to shallow clone");
  31
  32   my $t = $map->get_typemap(ctype => 'unsigned int');
  33   $t->{blubb} = 1;
  34
  35   ok(!$clone->get_typemap(ctype => 'unsigned int')->{blubb}, "Direct modification does not propagate to full clone");
  36   ok($shallow->get_typemap(ctype => 'unsigned int')->{blubb}, "Direct modification does propagate to shallow clone");
  37 }
  38