Dpkg::Shlibs::Symbol::clone(): replaced by dclone() and sclone().

dclone() - deep cloning of the symbol.
sclone() - shallow copying of the symbol.

Signed-off-by: Modestas Vainius <modax@debian.org>
Signed-off-by: Raphaël Hertzog <hertzog@debian.org>

scripts/Dpkg/Shlibs/Symbol.pm

@@ -21,7 +21,7 @@ use warnings;
 use Dpkg::Gettext;
 use Dpkg::Deps;
 use Dpkg::ErrorHandling;
-use Storable qw(dclone);
+use Storable qw();
 
 sub new {
     my $this = shift;
@@ -40,15 +40,27 @@ sub new {
     return $self;
 }
 
-sub clone {
+# Shallow clone
+sub sclone {
     my $self = shift;
-    my $clone = dclone($self);
+    my $clone = { %$self };
+    if (@_) {
+	my %args=@_;
+	$clone->{$_} = $args{$_} foreach keys %args;
+    }
+    return bless $clone, ref $self;
+}
+
+# Deep clone
+sub dclone {
+    my $self = shift;
+    my $clone = Storable::dclone($self);
     if (@_) {
 	my %args=@_;
 	$clone->{$_} = $args{$_} foreach keys %args;
     }
     return $clone;
-};
+}
 
 sub parse_tagspec {
     my ($self, $tagspec) = @_;

scripts/Dpkg/Shlibs/SymbolFile.pm

@@ -125,7 +125,7 @@ sub load {
 
     sub new_symbol {
         my $base = shift || 'Dpkg::Shlibs::Symbol';
-        return (ref $base) ? $base->clone(@_) : $base->new(@_);
+        return (ref $base) ? $base->dclone(@_) : $base->new(@_);
     }
 
     if (defined($seen)) {
@@ -342,7 +342,7 @@ sub symbol_match_wildcard {
         my $w_sym = $obj->{wildcards}{$version};
         return undef unless $w_sym->arch_is_concerned($self->{arch});
         $self->{used_wildcards}++;
-        return $w_sym->clone(symbol => $name);
+        return $w_sym->dclone(symbol => $name);
     }
     return undef;
 }
@@ -430,7 +430,7 @@ sub lookup_symbol {
 	    $self->{objects}{$so}{syms}{$name}{deprecated}))
 	{
 	    my $dep_id = $self->{objects}{$so}{syms}{$name}{dep_id};
-	    my $clone = $self->{objects}{$so}{syms}{$name}->clone();
+	    my $clone = $self->{objects}{$so}{syms}{$name}->sclone();
 	    $clone->{depends} = $self->{objects}{$so}{deps}[$dep_id];
 	    $clone->{soname} = $so;
 	    return $clone;
@@ -455,7 +455,7 @@ sub get_new_symbols {
 		$refsyms->{$sym}{deprecated} or
 		not $refsyms->{$sym}->arch_is_concerned($self->{arch}) )
 	    {
-		push @res, $mysyms->{$sym}->clone(soname => $soname);
+		push @res, $mysyms->{$sym}->sclone(soname => $soname);
 	    }
 	}
     }

scripts/t/200_Dpkg_Shlibs.t

@@ -13,7 +13,7 @@
 # You should have received a copy of the GNU General Public License
 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
 
-use Test::More tests => 63;
+use Test::More tests => 65;
 use Cwd;
 use IO::String;
 
@@ -393,3 +393,13 @@ is_deeply($sym, Dpkg::Shlibs::Symbol->new( 'symbol' => 'symbol51_untagged@Base',
 		  'tags' => { 'optional' => 'from parent', 't' => 'v' },
 		  'tagorder' => [ 'optional', 't' ] ),
 	    'symbols are properly cloned when #including');
+
+# Test Symbol::sclone() and Symbol::dclone()
+$sym = Dpkg::Shlibs::Symbol->new(symbol => 'foobar', testfield => 1, teststruct => { 'foo' => 1 });
+@tmp = ( $sym->sclone(), $sym->dclone() );
+$tmp[0]->{teststruct}{foo} = 2;
+$tmp[0]->{testfield} = 2;
+$tmp[1]->{teststruct}{foo} = 3;
+$tmp[1]->{testfield} = 3;
+is ( $sym->{teststruct}{foo}, 2, 'struct changed via sclone()' );
+is ( $sym->{testfield}, 1, 'original field not changed' );