diff options
| -rw-r--r-- | embedvar.h | 2 | ||||
| -rw-r--r-- | intrpvar.h | 2 | ||||
| -rw-r--r-- | lib/open.t | 11 | ||||
| -rw-r--r-- | perlapi.h | 2 | ||||
| -rw-r--r-- | perlio.c | 26 |
5 files changed, 33 insertions, 10 deletions
diff --git a/embedvar.h b/embedvar.h index c1c77d2d89..612ebdbe7a 100644 --- a/embedvar.h +++ b/embedvar.h @@ -271,6 +271,7 @@ #define PL_hints (vTHX->Ihints) #define PL_in_clean_all (vTHX->Iin_clean_all) #define PL_in_clean_objs (vTHX->Iin_clean_objs) +#define PL_in_load_module (vTHX->Iin_load_module) #define PL_in_my (vTHX->Iin_my) #define PL_in_my_stash (vTHX->Iin_my_stash) #define PL_incgv (vTHX->Iincgv) @@ -559,6 +560,7 @@ #define PL_Ihints PL_hints #define PL_Iin_clean_all PL_in_clean_all #define PL_Iin_clean_objs PL_in_clean_objs +#define PL_Iin_load_module PL_in_load_module #define PL_Iin_my PL_in_my #define PL_Iin_my_stash PL_in_my_stash #define PL_Iincgv PL_incgv diff --git a/intrpvar.h b/intrpvar.h index d4f92d2074..bb0b46d59c 100644 --- a/intrpvar.h +++ b/intrpvar.h @@ -496,3 +496,5 @@ PERLVARI(Iclocktick, long, 0) /* this many times() ticks in a second */ /* New variables must be added to the very end for binary compatibility. * XSUB.h provides wrapper functions via perlapi.h that make this * irrelevant, but not all code may be expected to #include XSUB.h. */ + +PERLVARI(Iin_load_module, int, 0) /* to prevent recursions in PerlIO_find_layer */ diff --git a/lib/open.t b/lib/open.t index 50292929c8..905308dabb 100644 --- a/lib/open.t +++ b/lib/open.t @@ -7,7 +7,7 @@ BEGIN { require Config; import Config; } -use Test::More tests => 16; +use Test::More tests => 17; # open::import expects 'open' as its first argument, but it clashes with open() sub import { @@ -171,6 +171,15 @@ EOE "checking syswrite() output on :utf8 streams by reading it back in"); } +{ + use open IN => ':non-existent'; + eval { + require Anything; + }; + like($@, qr/Recursive call/i, + "test for an endless loop in PerlIO_find_layer"); +} + END { 1 while unlink "utf8"; 1 while unlink "a"; @@ -274,6 +274,8 @@ END_EXTERN_C #define PL_in_clean_all (*Perl_Iin_clean_all_ptr(aTHX)) #undef PL_in_clean_objs #define PL_in_clean_objs (*Perl_Iin_clean_objs_ptr(aTHX)) +#undef PL_in_load_module +#define PL_in_load_module (*Perl_Iin_load_module_ptr(aTHX)) #undef PL_in_my #define PL_in_my (*Perl_Iin_my_ptr(aTHX)) #undef PL_in_my_stash @@ -660,15 +660,23 @@ PerlIO_find_layer(pTHX_ const char *name, STRLEN len, int load) } if (load && PL_subname && PL_def_layerlist && PL_def_layerlist->cur >= 2) { - SV *pkgsv = newSVpvn("PerlIO", 6); - SV *layer = newSVpvn(name, len); - ENTER; - /* - * The two SVs are magically freed by load_module - */ - Perl_load_module(aTHX_ 0, pkgsv, Nullsv, layer, Nullsv); - LEAVE; - return PerlIO_find_layer(aTHX_ name, len, 0); + if (PL_in_load_module) { + Perl_croak(aTHX_ "Recursive call to Perl_load_module in PerlIO_find_layer"); + return NULL; + } else { + SV *pkgsv = newSVpvn("PerlIO", 6); + SV *layer = newSVpvn(name, len); + ENTER; + SAVEINT(PL_in_load_module); + PL_in_load_module++; + /* + * The two SVs are magically freed by load_module + */ + Perl_load_module(aTHX_ 0, pkgsv, Nullsv, layer, Nullsv); + PL_in_load_module--; + LEAVE; + return PerlIO_find_layer(aTHX_ name, len, 0); + } } PerlIO_debug("Cannot find %.*s\n", (int) len, name); return NULL; |