1#!/usr/bin/perl 2use strict; 3use warnings; 4 5use Test::More tests => 6; 6use ExtUtils::Typemaps; 7 8# Test that cloning typemap object shallowly or deeply both 9# works as designed. 10 11SCOPE: { 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 39