This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Avoid accessing free()d memory when calling reset in one thread, after
[perl5.git] / t / op / reset.t
1 #!./perl -w
2
3 BEGIN {
4     chdir 't' if -d 't';
5     @INC = '../lib';
6     require './test.pl';
7 }
8 use strict;
9
10 # Currently only testing the reset of patterns.
11 plan tests => 24;
12
13 package aiieee;
14
15 sub zlopp {
16     (shift =~ ?zlopp?) ? 1 : 0;
17 }
18
19 sub reset_zlopp {
20     reset;
21 }
22
23 package CLINK;
24
25 sub ZZIP {
26     shift =~ ?ZZIP? ? 1 : 0;
27 }
28
29 sub reset_ZZIP {
30     reset;
31 }
32
33 package main;
34
35 is(aiieee::zlopp(""), 0, "mismatch doesn't match");
36 is(aiieee::zlopp("zlopp"), 1, "match matches first time");
37 is(aiieee::zlopp(""), 0, "mismatch doesn't match");
38 is(aiieee::zlopp("zlopp"), 0, "match doesn't match second time");
39 aiieee::reset_zlopp();
40 is(aiieee::zlopp("zlopp"), 1, "match matches after reset");
41 is(aiieee::zlopp(""), 0, "mismatch doesn't match");
42
43 aiieee::reset_zlopp();
44
45 is(aiieee::zlopp(""), 0, "mismatch doesn't match");
46 is(aiieee::zlopp("zlopp"), 1, "match matches first time");
47 is(CLINK::ZZIP(""), 0, "mismatch doesn't match");
48 is(CLINK::ZZIP("ZZIP"), 1, "match matches first time");
49 is(CLINK::ZZIP(""), 0, "mismatch doesn't match");
50 is(CLINK::ZZIP("ZZIP"), 0, "match doesn't match second time");
51 is(aiieee::zlopp(""), 0, "mismatch doesn't match");
52 is(aiieee::zlopp("zlopp"), 0, "match doesn't match second time");
53
54 aiieee::reset_zlopp();
55 is(aiieee::zlopp("zlopp"), 1, "match matches after reset");
56 is(aiieee::zlopp(""), 0, "mismatch doesn't match");
57
58 is(CLINK::ZZIP(""), 0, "mismatch doesn't match");
59 is(CLINK::ZZIP("ZZIP"), 0, "match doesn't match third time");
60
61 CLINK::reset_ZZIP();
62 is(CLINK::ZZIP("ZZIP"), 1, "match matches after reset");
63 is(CLINK::ZZIP(""), 0, "mismatch doesn't match");
64
65
66 undef $/;
67 my $prog = <DATA>;
68
69 SKIP:
70 {
71     eval {require threads; 1} or
72         skip "No threads", 4;
73     foreach my $eight ('/', '?') {
74         foreach my $nine ('/', '?') {
75             my $copy = $prog;
76             $copy =~ s/8/$eight/gm;
77             $copy =~ s/9/$nine/gm;
78             fresh_perl_is($copy, "pass", "",
79                           "first pattern $eight$eight, second $nine$nine");
80         }
81     }
82 }
83
84 __DATA__
85 #!perl
86 use warnings;
87 use strict;
88
89 # Note that there are no digits in this program, other than the placeholders
90 sub a {
91 8one8;
92 }
93 sub b {
94 9two9;
95 }
96
97 use threads;
98 use threads::shared;
99
100 sub wipe {
101     eval 'no warnings; sub b {}';
102 }
103
104 sub lock_then_wipe {
105     my $l_r = shift;
106     lock $$l_r;
107     cond_wait($$l_r) until $$l_r eq "B";
108     wipe;
109     $$l_r = "C";
110     cond_signal $$l_r;
111 }
112
113 my $lock : shared = "A";
114 my $r = \$lock;
115
116 my $t;
117 {
118     lock $$r;
119     $t = threads->new(\&lock_then_wipe, $r);
120     wipe;
121     $lock = "B";
122     cond_signal $lock;
123 }
124
125 {
126     lock $lock;
127     cond_wait($lock) until $lock eq "C";
128     reset;
129 }
130
131 $t->join;
132 print "pass\n";