Front page | perl.perl5.porters |
Postings from March 2016
Hello,
This could be a bit of a long one, so I apologise about that in advance!
I got a report from a user of my AmigaOS4 port that the following simple
test was hanging.
#!SDK:Local/C/perl
open STDOUT, "| $^X ram:test4.pl" or die;
print "This is from test3.pl\n";
close STDOUT;
where test4.pl was simply
#!SDK:Local/C/perl
print <>;
After a bit debugging I determined the parent script was hanging because
PerlIO_refcnt_dec() was attempting to decrement FD 1 (stdout) to less than
0 and hence trying to croak(), whilst the &PL_perlio_mutex was locked, via
Perl_croak_nocontext() which in turn calls PerlIO_refcnt_inc() on STDERR
and so hanging on the equivalent MUTEX_LOCK call in refcnt_inc() .(AmigaOS4
perl uses interpreter threads for fork emulation etc.)
This problem was only happening with STDOUT not a "normal" file handle and
only when STDOUT was redirected to a piped command , redirecting to a file
was okay.
Afetr significant amount of hair pulling I finally found the reason for the
extra decrement in FD1 (from closing STDOUT) that causes the croak / hang
on the Perlio_mutex.
I'm using this variation on Per; -my_popen at line 3172 which was existing
code that seamed to
do what I needed.
I32
Perl_my_pclose(pTHX_ PerlIO *ptr)
{
/* Needs work for PerlIO ! */
FILE * const f = PerlIO_findFILE(ptr);
const I32 result = pclose(f);
PerlIO_releaseFILE(ptr,f);
return result;
}
It calls PerlIO_findFILE
FILE *
PerlIO_findFILE(PerlIO *f)
{
PerlIOl *l = *f;
FILE *stdio;
while (l) {
if (l->tab == &PerlIO_stdio) {
PerlIOStdio *s = PerlIOSelf(&l, PerlIOStdio);
return s->stdio;
}
l = *PerlIONext(&l);
}
/* Uses fallback "mode" via PerlIO_modestr() in PerlIO_exportFILE */
/* However, we're not really exporting a FILE * to someone else (who
becomes responsible for closing it, or calling PerlIO_releaseFILE())
So we need to undo its reference count increase on the underlying
file
descriptor. We have to do this, because if the loop above returns you
the FILE *, then *it* didn't increase any reference count. So there's
only one way to be consistent. */
stdio = PerlIO_exportFILE(f, NULL);
if (stdio) {
const int fd = fileno(stdio);
if (fd >= 0)
{
PerlIOUnix_refcnt_dec(fd);
}
}
return stdio;
}
If the filehandle is not a stdio one ie the test script did open FOO, "|
command"; then it's found by the section above the comment.
If its STDOUT (haven't checked STDIN and STDERR yet, but I'd guess they are
the same) then it's not found and falls throught to the section below the
comment, which does a PerlIOUnix_refcnt_dec().
However contrary to the statement made in the comment the Perl_my_pclose()
above does call PerlIO_releaseFILE() and soes close the file itself.
Resulting in the extra decrement.
First thought is that the usage of PerlIO_findFILE() in this context is
wrong but I search through the source and can only find three usages of the
function PerlIO_findFILE() and they all do the same as the above.
One usage is small variant on the Perl_my_popen() the other is in
ext/XS-Typemap/Typemap.xs
But there again afer searching POD does say:
=item B<PerlIO_findFILE(f)>
Returns a native FILE * used by a stdio layer. If there is none, it
will create one with PerlIO_exportFILE. In either case the FILE *
should be considered as belonging to PerlIO subsystem and should
only be closed by calling C<PerlIO_close()>.
So I'm wandering how best so solve this issue?
I've verfied that simply removing the PerlIO_recnt_dec() from
PerlIO_findFILE() does solve the deadlock issue on AmigaOS.
Since the API doc is quite clear on the fact that using it this way is wrong
should anew variation on the function be added? On the other hand all three
uses of the function in the perl core do it the "wrong way" and none the
"right" way, so perhaps the API should be chnaged to suit established
practice?
Andy
PS I'm also wandering if the croak() inside the mutex lock needs to be
fixed?
Thread Next