This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Break out the test for #72922 into a new test file.
authorNicholas Clark <nick@ccl4.org>
Mon, 21 Feb 2011 14:50:22 +0000 (14:50 +0000)
committerNicholas Clark <nick@ccl4.org>
Mon, 21 Feb 2011 14:50:22 +0000 (14:50 +0000)
Skip the new t/re/qr-72922.t under minitest.

MANIFEST
t/re/qr-72922.t [new file with mode: 0644]
t/re/qr.t

index 50553ef..0230231 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -5023,6 +5023,7 @@ t/re/pat_special_cc.t             See if special charclasses (\s \w \d) work the same as (\
 t/re/pat_special_cc_thr.t      See if special charclasses (\s \w \d) work the same as (\s and [\s]) under threads
 t/re/pat.t                     See if esoteric patterns work
 t/re/pat_thr.t                 See if esoteric patterns work in another thread
+t/re/qr-72922.t                        Test for bug #72922
 t/re/qr_gc.t                   See if qr doesn't leak
 t/re/qrstack.t                 See if qr expands the stack properly
 t/re/qr.t                      See if qr works
diff --git a/t/re/qr-72922.t b/t/re/qr-72922.t
new file mode 100644 (file)
index 0000000..5daaff0
--- /dev/null
@@ -0,0 +1,38 @@
+#!perl -w
+use strict;
+
+BEGIN {
+    require './test.pl';
+    skip_all_if_miniperl("no dynamic loading on miniperl, no Scalar::Util");
+    plan(tests => 14);
+}
+
+# [perl 72922]: A 'copy' of a Regex object which has magic should not crash
+# When a Regex object was copied and the copy weaken then the original regex object
+# could no longer be 'copied' with qr//
+
+use Scalar::Util 'weaken';
+sub s1 {
+    my $re = qr/abcdef/;
+    my $re_copy1 = $re;
+    my $re_weak_copy = $re;;
+    weaken($re_weak_copy);
+    my $re_copy2 = qr/$re/;
+
+    my $str_re = "$re";
+    is("$$re_weak_copy", $str_re, "weak copy equals original");
+    is("$re_copy1", $str_re, "copy1 equals original");
+    is("$re_copy2", $str_re, "copy2 equals original");
+
+    my $refcnt_start = Internals::SvREFCNT($$re_weak_copy);
+
+    undef $re;
+    is(Internals::SvREFCNT($$re_weak_copy), $refcnt_start - 1, "refcnt decreased");
+    is("$re_weak_copy", $str_re, "weak copy still equals original");
+
+    undef $re_copy2;
+    is(Internals::SvREFCNT($$re_weak_copy), $refcnt_start - 1, "refcnt not decreased");
+    is("$re_weak_copy", $str_re, "weak copy still equals original");
+}
+s1();
+s1();
index fa5135f..eeda05c 100644 (file)
--- a/t/re/qr.t
+++ b/t/re/qr.t
@@ -6,7 +6,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan tests => 6;
+plan tests => 5;
 
 my $rx = qr//;
 
@@ -81,64 +81,3 @@ for($'){
  $flile =~ qr/(?:)/;
  is $scratch, "[fetching]", '/$qr/ with magical LHS';
 }
-
-{
-    # [perl 72922]: A 'copy' of a Regex object which has magic should not crash
-    # When a Regex object was copied and the copy weaken then the original regex object
-    # could no longer be 'copied' with qr//
-
-    my $prog = tempfile();
-    open my $fh, ">", $prog or die "Can't write to tempfile";
-    print $fh <<'EOTEST';
-require "./test.pl";
-$verbose = 1;
-use Scalar::Util 'weaken';
-sub s1 {
-    my $re = qr/abcdef/;
-    my $re_copy1 = $re;
-    my $re_weak_copy = $re;;
-    weaken($re_weak_copy);
-    my $re_copy2 = qr/$re/;
-
-    my $str_re = "$re";
-    is("$$re_weak_copy", $str_re, "weak copy equals original");
-    is("$re_copy1", $str_re, "copy1 equals original");
-    is("$re_copy2", $str_re, "copy2 equals original");
-
-    my $refcnt_start = Internals::SvREFCNT($$re_weak_copy);
-
-    undef $re;
-    is(Internals::SvREFCNT($$re_weak_copy), $refcnt_start - 1, "refcnt decreased");
-    is("$re_weak_copy", $str_re, "weak copy still equals original");
-
-    undef $re_copy2;
-    is(Internals::SvREFCNT($$re_weak_copy), $refcnt_start - 1, "refcnt not decreased");
-    is("$re_weak_copy", $str_re, "weak copy still equals original");
-}
-s1();
-s1();
-EOTEST
-    close $fh;
-
-    my $out = runperl(stderr => 1, progfile => $prog);
-    unlink_all $prog;
-
-    my $expected = <<'EOOUT';
-ok 1 - weak copy equals original
-ok 2 - copy1 equals original
-ok 3 - copy2 equals original
-ok 4 - refcnt decreased
-ok 5 - weak copy still equals original
-ok 6 - refcnt not decreased
-ok 7 - weak copy still equals original
-ok 8 - weak copy equals original
-ok 9 - copy1 equals original
-ok 10 - copy2 equals original
-ok 11 - refcnt decreased
-ok 12 - weak copy still equals original
-ok 13 - refcnt not decreased
-ok 14 - weak copy still equals original
-EOOUT
-
-    is ($out, $expected, '[perl #72922] copy of a regex of which a weak copy exist');
-}