This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
test wrap_keyword_plugin (RT #132413)
authorLukas Mai <l.mai@web.de>
Thu, 9 Nov 2017 00:00:23 +0000 (01:00 +0100)
committerLukas Mai <l.mai@web.de>
Sat, 11 Nov 2017 10:16:31 +0000 (11:16 +0100)
MANIFEST
ext/XS-APItest/APItest.xs
ext/XS-APItest/t/keyword_plugin_threads.t [new file with mode: 0644]

index 7fcd227..7df52ed 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -4325,6 +4325,7 @@ ext/XS-APItest/t/hash.t           XS::APItest: tests for hash related APIs
 ext/XS-APItest/t/join_with_space.t     test op_convert_list
 ext/XS-APItest/t/keyword_multiline.t   test keyword plugin parsing across lines
 ext/XS-APItest/t/keyword_plugin.t      test keyword plugin mechanism
+ext/XS-APItest/t/keyword_plugin_threads.t      test keyword plugin loading from multiple threads
 ext/XS-APItest/t/labelconst.aux        auxiliary file for label test
 ext/XS-APItest/t/labelconst.t  test recursive descent label parsing
 ext/XS-APItest/t/labelconst_utf8.aux   auxiliary file for label test in UTF-8
index ffdc56c..8bf1545 100644 (file)
@@ -1242,6 +1242,7 @@ static int my_keyword_plugin(pTHX_
        *op_ptr = parse_join_with_space();
        return KEYWORD_PLUGIN_EXPR;
     } else {
+        assert(next_keyword_plugin != my_keyword_plugin);
        return next_keyword_plugin(aTHX_ keyword_ptr, keyword_len, op_ptr);
     }
 }
@@ -3893,8 +3894,7 @@ BOOT:
     hintkey_DEFSV_sv = newSVpvs_share("XS::APItest/DEFSV");
     hintkey_with_vars_sv = newSVpvs_share("XS::APItest/with_vars");
     hintkey_join_with_space_sv = newSVpvs_share("XS::APItest/join_with_space");
-    next_keyword_plugin = PL_keyword_plugin;
-    PL_keyword_plugin = my_keyword_plugin;
+    wrap_keyword_plugin(my_keyword_plugin, &next_keyword_plugin);
 }
 
 void
diff --git a/ext/XS-APItest/t/keyword_plugin_threads.t b/ext/XS-APItest/t/keyword_plugin_threads.t
new file mode 100644 (file)
index 0000000..db23ce7
--- /dev/null
@@ -0,0 +1,32 @@
+#!perl
+use strict;
+use warnings;
+
+require '../../t/test.pl';
+
+use Config;
+if (!$Config{useithreads}) {
+    skip_all("keyword_plugin thread test requires threads");
+}
+
+plan(1);
+
+fresh_perl_is( <<'----', <<'====', {}, "loading XS::APItest in threads works");
+use strict;
+use warnings;
+
+use threads;
+
+require '../../t/test.pl';
+watchdog(5);
+
+for my $t (1 .. 3) {
+    threads->create(sub {
+        require XS::APItest;
+    })->join;
+}
+
+print "all is well\n";
+----
+all is well
+====