Hello community, here is the log from the commit of package perl-Clone for openSUSE:Factory checked in at 2019-11-23 23:10:36 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/perl-Clone (Old) and /work/SRC/openSUSE:Factory/.perl-Clone.new.26869 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "perl-Clone" Sat Nov 23 23:10:36 2019 rev:29 rq:748732 version:0.43 Changes: -------- --- /work/SRC/openSUSE:Factory/perl-Clone/perl-Clone.changes 2018-11-12 09:39:01.833394977 +0100 +++ /work/SRC/openSUSE:Factory/.perl-Clone.new.26869/perl-Clone.changes 2019-11-23 23:10:43.438732381 +0100 @@ -1,0 +2,21 @@ +Wed Jul 31 05:03:45 UTC 2019 - Stephan Kulow <co...@suse.com> + +- updated to 0.43 + see /usr/share/doc/packages/perl-Clone/Changes + + 0.43 2019-07-29 13:47:42 atomic + - fix an issue when cloning a NULL mg_ptr pointer + +------------------------------------------------------------------- +Fri Jul 19 05:32:49 UTC 2019 - Stephan Kulow <co...@suse.com> + +- updated to 0.42 + see /usr/share/doc/packages/perl-Clone/Changes + + 0.42 2019-07-19 23:06:04 garu + - make handling of mg_ptr safer (ATOOMIC, Harald Jörg) + - change license wording on some test files to + make the entire dist released under the same + terms as Perl itself (fixes GH#20) (GARU) + +------------------------------------------------------------------- Old: ---- Clone-0.41.tar.gz New: ---- Clone-0.43.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ perl-Clone.spec ++++++ --- /var/tmp/diff_new_pack.Bt4jTS/_old 2019-11-23 23:10:45.226732572 +0100 +++ /var/tmp/diff_new_pack.Bt4jTS/_new 2019-11-23 23:10:45.226732572 +0100 @@ -1,7 +1,7 @@ # # spec file for package perl-Clone # -# Copyright (c) 2018 SUSE LINUX GmbH, Nuernberg, Germany. +# Copyright (c) 2019 SUSE LINUX GmbH, Nuernberg, Germany. # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -17,18 +17,19 @@ Name: perl-Clone -Version: 0.41 +Version: 0.43 Release: 0 %define cpan_name Clone -Summary: Recursively Copy Perl Datatypes +Summary: Recursively copy Perl datatypes License: Artistic-1.0 OR GPL-1.0-or-later Group: Development/Libraries/Perl Url: https://metacpan.org/release/%{cpan_name} -Source0: https://cpan.metacpan.org/authors/id/G/GA/GARU/%{cpan_name}-%{version}.tar.gz +Source0: https://cpan.metacpan.org/authors/id/A/AT/ATOOMIC/%{cpan_name}-%{version}.tar.gz Source1: cpanspec.yml BuildRoot: %{_tmppath}/%{name}-%{version}-build BuildRequires: perl BuildRequires: perl-macros +BuildRequires: perl(B::COW) %{perl_requires} %description @@ -51,10 +52,10 @@ %build perl Makefile.PL INSTALLDIRS=vendor OPTIMIZE="%{optflags}" -%{__make} %{?_smp_mflags} +make %{?_smp_mflags} %check -%{__make} test +make test %install %perl_make_install @@ -63,6 +64,6 @@ %files -f %{name}.files %defattr(-,root,root,755) -%doc Changes +%doc Changes README.md %changelog ++++++ Clone-0.41.tar.gz -> Clone-0.43.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Clone-0.41/Changes new/Clone-0.43/Changes --- old/Clone-0.41/Changes 2018-10-25 15:32:34.000000000 +0200 +++ new/Clone-0.43/Changes 2019-07-29 21:48:05.000000000 +0200 @@ -1,10 +1,20 @@ Revision history for Perl module Clone +0.43 2019-07-29 13:47:42 atomic + - fix an issue when cloning a NULL mg_ptr pointer + +0.42 2019-07-19 23:06:04 garu + - make handling of mg_ptr safer (ATOOMIC, Harald Jörg) + - change license wording on some test files to + make the entire dist released under the same + terms as Perl itself (fixes GH#20) (GARU) + 0.41 2018-10-25 10:20:03 garu - Check the CowREFCNT of a COWed PV (ATOOMIC) this should fix some issues people have been having with 0.40 on DBD drives and DBIx::Class - Make buildtools files not executable (Mohammad S Anwar) + - Move bugtracker to Github (GARU) 0.40 2018-10-23 20:001:49 garu - reuse COWed PV when cloning (fixes RT97535) (ATOOMIC) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Clone-0.41/Clone.pm new/Clone-0.43/Clone.pm --- old/Clone-0.41/Clone.pm 2018-10-25 15:22:15.000000000 +0200 +++ new/Clone-0.43/Clone.pm 2019-07-29 21:48:29.000000000 +0200 @@ -11,7 +11,7 @@ @EXPORT = qw(); @EXPORT_OK = qw( clone ); -$VERSION = '0.41'; +$VERSION = '0.43'; bootstrap Clone $VERSION; @@ -81,7 +81,7 @@ =head1 COPYRIGHT -Copyright 2001-2018 Ray Finch. All Rights Reserved. +Copyright 2001-2019 Ray Finch. All Rights Reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Clone-0.41/Clone.xs new/Clone-0.43/Clone.xs --- old/Clone-0.41/Clone.xs 2018-10-25 15:19:31.000000000 +0200 +++ new/Clone-0.43/Clone.xs 2019-07-29 21:46:41.000000000 +0200 @@ -176,26 +176,33 @@ */ #if PERL_VERSION >= 20 && !defined(PERL_DEBUG_READONLY_COW) /* only for simple PVs unblessed */ - if ( SvIsCOW(ref) && !SvOOK(ref) && SvLEN(ref) > 0 - && CowREFCNT(ref) < SV_COW_REFCNT_MAX ) { - /* cannot use newSVpv_share as this going to use a new PV we do not want to clone it */ - /* create a fresh new PV */ - clone = newSV(0); - sv_upgrade(clone, SVt_PV); - SvPOK_on(clone); - SvIsCOW_on(clone); - - /* points the str slot to the COWed one */ - SvPV_set(clone, SvPVX(ref) ); - CowREFCNT(ref)++; - - /* preserve cur, len, flags and utf8 flag */ - SvCUR_set(clone, SvCUR(ref)); - SvLEN_set(clone, SvLEN(ref)); - //SvFLAGS(clone) = SvFLAGS(ref); + if ( SvIsCOW(ref) && !SvOOK(ref) && SvLEN(ref) > 0 ) { - if (SvUTF8(ref)) - SvUTF8_on(clone); + if ( CowREFCNT(ref) < (SV_COW_REFCNT_MAX - 1) ) { + /* cannot use newSVpv_share as this going to use a new PV we do not want to clone it */ + /* create a fresh new PV */ + clone = newSV(0); + sv_upgrade(clone, SVt_PV); + SvPOK_on(clone); + SvIsCOW_on(clone); + + /* points the str slot to the COWed one */ + SvPV_set(clone, SvPVX(ref) ); + CowREFCNT(ref)++; + + /* preserve cur, len, flags and utf8 flag */ + SvCUR_set(clone, SvCUR(ref)); + SvLEN_set(clone, SvLEN(ref)); + SvFLAGS(clone) = SvFLAGS(ref); /* preserve all the flags from the original SV */ + + if (SvUTF8(ref)) + SvUTF8_on(clone); + } else { + /* we are above SV_COW_REFCNT_MAX, create a new SvPV but preserve the COW */ + clone = newSVsv (ref); + SvIsCOW_on(clone); + CowREFCNT(clone) = 0; /* set the CowREFCNT to 0 */ + } } else { clone = newSVsv (ref); @@ -283,18 +290,14 @@ obj = mg->mg_obj; break; case 't': /* PERL_MAGIC_taint */ - continue; - break; - case '<': /* PERL_MAGIC_backref */ - continue; - break; + case '<': /* PERL_MAGIC_backref */ case '@': /* PERL_MAGIC_arylen_p */ - continue; + continue; break; case 'P': /* PERL_MAGIC_tied */ case 'p': /* PERL_MAGIC_tiedelem */ case 'q': /* PERL_MAGIC_tiedscalar */ - magic_ref++; + magic_ref++; /* fall through */ default: obj = sv_clone(mg->mg_obj, hseen, -1); @@ -302,12 +305,39 @@ } else { TRACEME(("magic object for type %c in NULL\n", mg->mg_type)); } - /* this is plain old magic, so do the same thing */ - sv_magic(clone, - obj, - mg->mg_type, - mg->mg_ptr, - mg->mg_len); + + { /* clone the mg_ptr pv */ + char *mg_ptr = mg->mg_ptr; /* default */ + + if (mg->mg_len >= 0) { /* copy the pv */ + if (mg_ptr) { + Newxz(mg_ptr, mg->mg_len+1, char); /* add +1 for the NULL at the end? */ + Copy(mg->mg_ptr, mg_ptr, mg->mg_len, char); + } + } else if (mg->mg_len == HEf_SVKEY) { + /* let's share the SV for now */ + SvREFCNT_inc((SV*)mg->mg_ptr); + /* maybe we also want to clone the SV... */ + //if (mg_ptr) mg->mg_ptr = (char*) sv_clone((SV*)mg->mg_ptr, hseen, -1); + } else if (mg->mg_len == -1 && mg->mg_type == PERL_MAGIC_utf8) { /* copy the cache */ + if (mg->mg_ptr) { + STRLEN *cache; + Newxz(cache, PERL_MAGIC_UTF8_CACHESIZE * 2, STRLEN); + mg_ptr = (char *) cache; + Copy(mg->mg_ptr, mg_ptr, PERL_MAGIC_UTF8_CACHESIZE * 2, STRLEN); + } + } else if ( mg->mg_ptr != NULL) { + croak("Unsupported magic_ptr clone"); + } + + /* this is plain old magic, so do the same thing */ + sv_magic(clone, + obj, + mg->mg_type, + mg_ptr, + mg->mg_len); + + } } /* major kludge - why does the vtable for a qr type need to be null? */ if ( (mg = mg_find(clone, 'r')) ) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Clone-0.41/MANIFEST new/Clone-0.43/MANIFEST --- old/Clone-0.41/MANIFEST 2018-10-25 15:34:23.000000000 +0200 +++ new/Clone-0.43/MANIFEST 2019-07-29 21:49:45.000000000 +0200 @@ -4,7 +4,7 @@ Makefile.PL MANIFEST META.yml Module meta-data (added by MakeMaker) -README +README.md t/01array.t t/02hash.t t/03scalar.t diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Clone-0.41/META.json new/Clone-0.43/META.json --- old/Clone-0.41/META.json 2018-10-25 15:34:23.000000000 +0200 +++ new/Clone-0.43/META.json 2019-07-29 21:49:45.000000000 +0200 @@ -4,13 +4,13 @@ "Ray Finch <r...@cpan.org>" ], "dynamic_config" : 1, - "generated_by" : "ExtUtils::MakeMaker version 7.34, CPAN::Meta::Converter version 2.150010", + "generated_by" : "ExtUtils::MakeMaker version 7.24, CPAN::Meta::Converter version 2.150010", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec";, - "version" : 2 + "version" : "2" }, "name" : "Clone", "no_index" : { @@ -22,13 +22,19 @@ "prereqs" : { "build" : { "requires" : { - "Test::More" : "0" + "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } + }, + "test" : { + "requires" : { + "B::COW" : "0", + "Test::More" : "0" + } } }, "release_status" : "stable", @@ -43,6 +49,6 @@ "url" : "http://github.com/garu/Clone"; } }, - "version" : "0.41", - "x_serialization_backend" : "JSON::PP version 2.97001" + "version" : "0.43", + "x_serialization_backend" : "JSON::PP version 2.27400_02" } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Clone-0.41/META.yml new/Clone-0.43/META.yml --- old/Clone-0.41/META.yml 2018-10-25 15:34:22.000000000 +0200 +++ new/Clone-0.43/META.yml 2019-07-29 21:49:45.000000000 +0200 @@ -3,11 +3,13 @@ author: - 'Ray Finch <r...@cpan.org>' build_requires: + B::COW: '0' + ExtUtils::MakeMaker: '0' Test::More: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 -generated_by: 'ExtUtils::MakeMaker version 7.34, CPAN::Meta::Converter version 2.150010' +generated_by: 'ExtUtils::MakeMaker version 7.24, CPAN::Meta::Converter version 2.150010' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html @@ -21,5 +23,5 @@ bugtracker: https://github.com/garu/Clone/issues license: http://dev.perl.org/licenses/ repository: http://github.com/garu/Clone -version: '0.41' +version: '0.43' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Clone-0.41/Makefile.PL new/Clone-0.43/Makefile.PL --- old/Clone-0.41/Makefile.PL 2018-10-25 15:23:04.000000000 +0200 +++ new/Clone-0.43/Makefile.PL 2018-10-30 16:41:30.000000000 +0100 @@ -7,8 +7,9 @@ 'ABSTRACT_FROM' => 'Clone.pm', 'LICENSE' => 'perl', 'PL_FILES' => {}, - 'BUILD_REQUIRES' => { + 'TEST_REQUIRES' => { 'Test::More' => 0, + 'B::COW' => 0, }, 'LIBS' => [''], # e.g., '-lm' 'DEFINE' => '', # e.g., '-DHAVE_SOMETHING' diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Clone-0.41/README.md new/Clone-0.43/README.md --- old/Clone-0.41/README.md 1970-01-01 01:00:00.000000000 +0100 +++ new/Clone-0.43/README.md 2019-07-29 21:28:06.000000000 +0200 @@ -0,0 +1,78 @@ +Clone - recursively copy Perl datatypes +======================================= + +[](https://travis-ci.org/garu/Clone) +[](https://coveralls.io/r/garu/Clone?branch=master) +[](https://metacpan.org/pod/Clone) + +This module provides a `clone()` method which makes recursive +copies of nested hash, array, scalar and reference types, +including tied variables and objects. + +```perl + use Clone 'clone'; + + my $data = { + set => [ 1 .. 50 ], + foo => { + answer => 42, + object => SomeObject->new, + }, + }; + + my $cloned_data = clone($data); + + $cloned_data->{foo}{answer} = 1; + print $cloned_data->{foo}{answer}; # '1' + print $data->{foo}{answer}; # '42' +``` + +You can also add it to your class: + +```perl + package Foo; + use parent 'Clone'; + sub new { bless {}, shift } + + package main; + + my $obj = Foo->new; + my $copy = $obj->clone; +``` + +`clone()` takes a scalar argument and duplicates it. To duplicate lists, +arrays or hashes, pass them in by reference, e.g. + +```perl + my $copy = clone (\@array); + + # or + + my %copy = %{ clone (\%hash) }; +``` + +See Also +-------- + +[Storable](https://metacpan.org/pod/Storable)'s `dclone()` is a flexible solution for cloning variables, +albeit slower for average-sized data structures. Simple +and naive benchmarks show that Clone is faster for data structures +with 3 or fewer levels, while `dclone()` can be faster for structures +4 or more levels deep. + +COPYRIGHT +--------- + +Copyright 2001-2019 Ray Finch. All Rights Reserved. + +This module is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +AUTHOR +------ + +Ray Finch `<r...@cpan.org>` + +Breno G. de Oliveira `<g...@cpan.org>` and +Florian Ragwitz `<r...@debian.org>` perform routine maintenance +releases since 2012. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Clone-0.41/t/03scalar.t new/Clone-0.43/t/03scalar.t --- old/Clone-0.41/t/03scalar.t 2018-10-25 15:19:31.000000000 +0200 +++ new/Clone-0.43/t/03scalar.t 2019-07-29 21:28:06.000000000 +0200 @@ -129,7 +129,7 @@ my $str = 'abcdefg'; my $qr = qr/$str/; my $qc = clone( $qr ); -ok( $qr eq $qc, 'string check' ); +ok( $qr eq $qc, 'string check' ) or warn "$qr vs $qc"; ok( $str =~ /$qc/, 'regexp check' ); # test for unicode support diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Clone-0.41/t/06refcnt.t new/Clone-0.43/t/06refcnt.t --- old/Clone-0.41/t/06refcnt.t 2014-05-10 15:33:02.000000000 +0200 +++ new/Clone-0.43/t/06refcnt.t 2019-07-29 21:26:47.000000000 +0200 @@ -10,21 +10,21 @@ my $HAS_WEAKEN; BEGIN { - $| = 1; - my $plan = 20; + $| = 1; + my $plan = 25; - eval 'use Scalar::Util qw( weaken isweak );'; - if ($@) { - $HAS_WEAKEN = 0; - $plan = 15; - } - else { - $HAS_WEAKEN = 1; - } + eval 'use Scalar::Util qw( weaken isweak );'; + if ($@) { + $HAS_WEAKEN = 0; + $plan = 15; + } + else { + $HAS_WEAKEN = 1; + } - print "1..$plan\n"; + print "1..$plan\n"; } -END {print "not ok 1\n" unless $loaded;} +END { print "not ok 1\n" unless $loaded; } use Clone qw( clone ); $loaded = 1; print "ok 1\n"; @@ -41,114 +41,205 @@ ## use Data::Dumper; # use Storable qw( dclone ); -$^W = 1; +$^W = 1; $test = 2; -sub ok { printf("ok %d\n", $test++); } -sub not_ok { printf("not ok %d\n", $test++); } - use strict; package Test::Hash; @Test::Hash::ISA = qw( Clone ); -sub new() -{ - my ($class) = @_; - my $self = {}; - bless $self, $class; +sub new() { + my ($class) = @_; + my $self = {}; + bless $self, $class; } my $ok = 0; -END { $ok = 1; }; -sub DESTROY -{ - my $self = shift; - printf("not ") if $ok; - printf("ok %d\n", $::test++); +END { $ok = 1; } + +sub DESTROY { + my $self = shift; + printf("not ") if $ok; + printf( "ok %d - DESTROY\n", $::test++ ); } package main; { - my $a = Test::Hash->new(); - my $b = $a->clone; - # my $c = dclone($a); + my $a = Test::Hash->new(); + my $b = $a->clone; + + # my $c = dclone($a); } # benchmarking bug { - my $a = Test::Hash->new(); - my $sref = sub { my $b = clone($a) }; - $sref->(); + my $a = Test::Hash->new(); + my $sref = sub { my $b = clone($a) }; + $sref->(); } # test for cloning unblessed ref { - my $a = {}; - my $b = clone($a); - bless $a, 'Test::Hash'; - bless $b, 'Test::Hash'; + my $a = {}; + my $b = clone($a); + bless $a, 'Test::Hash'; + bless $b, 'Test::Hash'; } # test for cloning unblessed ref { - my $a = []; - my $b = clone($a); - bless $a, 'Test::Hash'; - bless $b, 'Test::Hash'; + my $a = []; + my $b = clone($a); + bless $a, 'Test::Hash'; + bless $b, 'Test::Hash'; } # test for cloning ref that was an int(IV) { - my $a = 1; - $a = []; - my $b = clone($a); - bless $a, 'Test::Hash'; - bless $b, 'Test::Hash'; + my $a = 1; + $a = []; + my $b = clone($a); + bless $a, 'Test::Hash'; + bless $b, 'Test::Hash'; } # test for cloning ref that was a string(PV) { - my $a = ''; - $a = []; - my $b = clone($a); - bless $a, 'Test::Hash'; - bless $b, 'Test::Hash'; + my $a = ''; + $a = []; + my $b = clone($a); + bless $a, 'Test::Hash'; + bless $b, 'Test::Hash'; } # test for cloning ref that was a magic(PVMG) { - my $a = *STDOUT; - $a = []; - my $b = clone($a); - bless $a, 'Test::Hash'; - bless $b, 'Test::Hash'; + my $a = *STDOUT; + $a = []; + my $b = clone($a); + bless $a, 'Test::Hash'; + bless $b, 'Test::Hash'; } # test for cloning weak reference -if ( $HAS_WEAKEN ) { - { - my $a = new Test::Hash(); - my $b = { r => $a }; - $a->{r} = $b; - weaken($b->{'r'}); - my $c = clone($a); - } - - # another weak reference problem, this one causes a segfault in 0.24 - { - my $a = new Test::Hash(); +if ($HAS_WEAKEN) { { - my $b = [ $a, $a ]; - $a->{r} = $b; - weaken($b->[0]); - weaken($b->[1]); - } - my $c = clone($a); - # check that references point to the same thing - print "not " unless $c->{'r'}[0] == $c->{'r'}[1]; - printf "ok %d\n", $::test++; - } + my $a = Test::Hash->new; + my $b = { r => $a }; + $a->{r} = $b; + weaken( $b->{'r'} ); + my $c = clone($a); + } + + # another weak reference problem, this one causes a segfault in 0.24 + { + my $a = Test::Hash->new; + { + my $b = [ $a, $a ]; + $a->{r} = $b; + weaken( $b->[0] ); + weaken( $b->[1] ); + } + + my $c = clone($a); + + # check that references point to the same thing + is( $c->{'r'}[0], $c->{'r'}[1], "references point to the same thing" ); + isnt( $c->{'r'}[0], $a->{'r'}[0], "a->{r}->[0] ne c->{r}->[0]" ); + + require B; + my $c_obj = B::svref_2object($c); + is( $c_obj->REFCNT, 1, 'c REFCNT = 1' ) + or diag( "refcnt is ", $c_obj->REFCNT ); + + my $cr_obj = B::svref_2object( $c->{'r'} ); + is( $cr_obj->REFCNT, 1, 'cr REFCNT = 1' ) + or diag( "refcnt is ", $cr_obj->REFCNT ); + + my $cr_0_obj = B::svref_2object( $c->{'r'}->[0] ); + is( $cr_0_obj->REFCNT, 1, 'c->{r}->[0] REFCNT = 1' ) + or diag( "refcnt is ", $cr_0_obj->REFCNT ); + + my $cr_1_obj = B::svref_2object( $c->{'r'}->[1] ); + is( $cr_1_obj->REFCNT, 1, 'c->{r}->[1] REFCNT = 1' ) + or diag( "refcnt is ", $cr_1_obj->REFCNT ); + + } +} + +exit; + +sub diag { + my (@msg) = @_; + + print STDERR join( ' ', '#', @msg, "\n" ); + return; +} + +sub ok { + my $msg = shift; + $msg = '' unless defined $msg; + $msg = ' - ' . $msg if length $msg; + printf( "ok %d%s\n", $::test++, $msg ); + + return 1; +} + +sub not_ok { + my $msg = shift; + $msg = '' unless defined $msg; + + printf( "not ok %d %s\n", $::test++, $msg ); + + return; +} + +sub is { + my ( $x, $y, $msg ) = @_; + + # dumb for now + $x = 'undef' if !defined $x; + $y = 'undef' if !defined $y; + + if ( !defined $x && !defined $y ) { + return ok($msg); + } + + if ( !defined $x || !defined $y ) { + return not_ok($msg); + } + + if ( $x eq $y ) { + return ok($msg); + } + else { + return not_ok($msg); + } } + +sub isnt { + my ( $x, $y, $msg ) = @_; + + # dumb for now + $x = 'undef' if !defined $x; + $y = 'undef' if !defined $y; + + if ( !defined $x && !defined $y ) { + return no_ok($msg); + } + + if ( !defined $x || !defined $y ) { + return ok($msg); + } + + if ( $x eq $y ) { + return not_ok($msg); + } + else { + return ok($msg); + } +} + diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Clone-0.41/t/07magic.t new/Clone-0.43/t/07magic.t --- old/Clone-0.41/t/07magic.t 2014-05-10 15:33:02.000000000 +0200 +++ new/Clone-0.43/t/07magic.t 2019-07-29 21:28:06.000000000 +0200 @@ -1,9 +1,9 @@ -# $Id: 07magic.t,v 1.8 2007/04/20 05:40:48 ray Exp $ +# $Id: 07magic.t,v 1.8 2019/07/16 15:32:45 ray Exp $ use strict; use Clone; -use Test::More tests => 3; +use Test::More tests => 10; SKIP: { eval "use Data::Dumper"; @@ -53,3 +53,37 @@ ok( Dumper($x) eq Dumper($y), "Tainted input"); } +SKIP: { + eval q{require Devel::Peek; require B; 1 } or skip "Devel::Peek or B missing", 7; + + my $clone_ref; + + { + # one utf8 string + my $content = "a\r\n"; + utf8::upgrade($content); + + # set the PERL_MAGIC_utf8 + index($content, "\n"); + + my $pv = B::svref_2object( \$content ); + is ref($pv), 'B::PVMG', "got a PV"; + ok $pv->MAGIC, "PV as a magic set"; + is $pv->MAGIC->TYPE, 'w', 'PERL_MAGIC_utf8'; + Devel::Peek::Dump( $content ); + + # Now clone it + $clone_ref = Clone::clone(\$content); + #is svref_2object( $clone_ref )->MAGIC->PTR, undef, 'undef ptr'; + # And inspect it with Devel::Peek. + $pv = B::svref_2object( $clone_ref ); + is ref($pv), 'B::PVMG', "clone - got a PV"; + ok $pv->MAGIC, "clone - PV as a magic set"; + is $pv->MAGIC->TYPE, 'w', 'clone - PERL_MAGIC_utf8'; + + Devel::Peek::Dump( $$clone_ref ); + + ok 1, "Dump without segfault"; + } +} + diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Clone-0.41/t/dclone.t new/Clone-0.43/t/dclone.t --- old/Clone-0.41/t/dclone.t 2017-04-07 12:44:01.000000000 +0200 +++ new/Clone-0.43/t/dclone.t 2019-07-29 21:28:06.000000000 +0200 @@ -5,9 +5,9 @@ # Id: dclone.t,v 0.6.1.1 2000/03/02 22:21:05 ram Exp # # Copyright (c) 1995-1998, Raphael Manfredi -# -# You may redistribute only under the terms of the Artistic License, -# as specified in the README file that comes with the distribution. +# +# You may redistribute and/or modify this file +# under the same terms as Perl itself. # # $Log: dclone.t,v $ # Revision 0.18 2006/10/08 03:37:29 ray diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Clone-0.41/t/dump.pl new/Clone-0.43/t/dump.pl --- old/Clone-0.41/t/dump.pl 2014-05-15 23:43:24.000000000 +0200 +++ new/Clone-0.43/t/dump.pl 2019-07-29 21:28:06.000000000 +0200 @@ -2,8 +2,8 @@ ;# ;# Copyright (c) 1995-2000, Raphael Manfredi ;# -;# You may redistribute only under the terms of the Artistic License, -;# as specified in the README file that comes with the distribution. +;# You may redistribute and/or modify this file +;# under the same terms as Perl itself. ;# ;# Log: dump.pl,v ;# Revision 0.7 2000/08/03 22:04:45 ram diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Clone-0.41/t/tied.pl new/Clone-0.43/t/tied.pl --- old/Clone-0.41/t/tied.pl 2017-04-07 12:44:01.000000000 +0200 +++ new/Clone-0.43/t/tied.pl 2019-07-29 21:28:06.000000000 +0200 @@ -4,8 +4,8 @@ # # Copyright (c) 1995-1998, Raphael Manfredi # -# You may redistribute only under the terms of the Artistic License, -# as specified in the README file that comes with the distribution. +# You may redistribute and/or modify this file +# under the same terms as Perl itself. # # $Log: tied.pl,v $ # Revision 0.18 2006/10/08 03:37:29 ray
