This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[perl #122476] use a hash instead of a ptr_table
authorTony Cook <tony@develop-help.com>
Mon, 11 Aug 2014 06:47:51 +0000 (16:47 +1000)
committerTony Cook <tony@develop-help.com>
Fri, 15 Aug 2014 01:17:57 +0000 (11:17 +1000)
Perl will duplicate the hash on ithread creation, so this will be
thread-safe.

ext/POSIX/POSIX.xs
ext/POSIX/lib/POSIX.pm
ext/POSIX/t/is.t

index 2a77df0..e3dac9b 100644 (file)
@@ -537,7 +537,6 @@ static XSPROTO(is_common); /* prototype to pass -Wmissing-prototypes */
 static XSPROTO(is_common)
 {
     dXSARGS;
-    static PTR_TBL_t * is_common_ptr_table;
 
     if (items != 1)
        croak_xs_usage(cv,  "charstring");
@@ -558,14 +557,12 @@ static XSPROTO(is_common)
              * called.  See thread at
              * http://markmail.org/thread/jhqcag5njmx7jpyu */
 
-           if (! is_common_ptr_table) {
-               is_common_ptr_table = ptr_table_new();
-            }
-           if (! ptr_table_fetch(is_common_ptr_table, PL_op)) {
+           HV *warned = get_hv("POSIX::_warned", GV_ADD | GV_ADDMULTI);
+           if (! hv_exists(warned, (const char *)&PL_op, sizeof(PL_op))) {
                 Perl_warner(aTHX_ packWARN(WARN_DEPRECATED),
                             "Calling POSIX::%"HEKf"() is deprecated",
                             HEKfARG(GvNAME_HEK(CvGV(cv))));
-                ptr_table_store(is_common_ptr_table, PL_op, (void *) 1);
+               hv_store(warned, (const char *)&PL_op, sizeof(PL_op), &PL_sv_yes, 0);
             }
         }
 
index 57845a7..3daa2f3 100644 (file)
@@ -4,7 +4,7 @@ use warnings;
 
 our ($AUTOLOAD, %SIGRT);
 
-our $VERSION = '1.41';
+our $VERSION = '1.42';
 
 require XSLoader;
 
index 911a256..6eb64fd 100644 (file)
@@ -130,7 +130,6 @@ SKIP:
     skip("No Win32API::File", 1)
       unless $Config{extensions} =~ m(\bWin32API/File\b);
 
-    local $TODO = "this code crashes perl";
     local $ENV{PERL5LIB} =
       join($Config{path_sep},
           map / / ? qq("$_") : $_, @INC);