Change 19656 by [EMAIL PROTECTED] on 2003/06/02 08:28:51
Since pulling in File::Temp for tempfiles would pull in
also Fcntl, miniperl could not open up tempfiles. This broke
the use of miniperl in VMS, as noticed by Craig Berry.
Try to cure this by moving the creation of tempfile into its
own routine, my_tmpfp(), which gets compiled differently
for miniperl and perl.
Affected files ...
... //depot/perl/embed.fnc#83 edit
... //depot/perl/embed.h#400 edit
... //depot/perl/op.c#565 edit
... //depot/perl/perlio.c#220 edit
... //depot/perl/proto.h#440 edit
Differences ...
==== //depot/perl/embed.fnc#83 (text) ====
Index: perl/embed.fnc
--- perl/embed.fnc#82~19637~ Thu May 29 11:47:40 2003
+++ perl/embed.fnc Mon Jun 2 01:28:51 2003
@@ -962,6 +962,8 @@
Adp |void |sv_nounlocking |SV *
Adp |int |nothreadhook
+p |PerlIO*|my_tmpfp
+
END_EXTERN_C
#if defined(PERL_IN_DOOP_C) || defined(PERL_DECL_PROT)
==== //depot/perl/embed.h#400 (text+w) ====
Index: perl/embed.h
--- perl/embed.h#399~19637~ Thu May 29 11:47:40 2003
+++ perl/embed.h Mon Jun 2 01:28:51 2003
@@ -1244,6 +1244,9 @@
#define sv_nolocking Perl_sv_nolocking
#define sv_nounlocking Perl_sv_nounlocking
#define nothreadhook Perl_nothreadhook
+#ifdef PERL_CORE
+#define my_tmpfp Perl_my_tmpfp
+#endif
#if defined(PERL_IN_DOOP_C) || defined(PERL_DECL_PROT)
#ifdef PERL_CORE
#define do_trans_simple S_do_trans_simple
@@ -3716,6 +3719,9 @@
#define sv_nolocking(a) Perl_sv_nolocking(aTHX_ a)
#define sv_nounlocking(a) Perl_sv_nounlocking(aTHX_ a)
#define nothreadhook() Perl_nothreadhook(aTHX)
+#ifdef PERL_CORE
+#define my_tmpfp() Perl_my_tmpfp(aTHX)
+#endif
#if defined(PERL_IN_DOOP_C) || defined(PERL_DECL_PROT)
#ifdef PERL_CORE
#define do_trans_simple(a) S_do_trans_simple(aTHX_ a)
==== //depot/perl/op.c#565 (text) ====
Index: perl/op.c
--- perl/op.c#564~19637~ Thu May 29 11:47:40 2003
+++ perl/op.c Mon Jun 2 01:28:51 2003
@@ -6510,3 +6510,69 @@
ST(0) = (SV*)XSANY.any_ptr;
XSRETURN(1);
}
+
+PerlIO*
+Perl_my_tmpfp(pTHX)
+{
+ dTHX;
+ PerlIO *f = NULL;
+ int fd = -1;
+#ifdef PERL_EXTERNAL_GLOB
+ /* File::Temp pulls in Fcntl, which may not be available with
+ * e.g. miniperl, use mkstemp() or stdio tmpfile() instead. */
+# ifdef HAS_MKSTEMP
+ SV *sv = newSVpv("/tmp/PerlIO_XXXXXX", 0);
+ fd = mkstemp(SvPVX(sv));
+ if (fd >= 0) {
+ f = PerlIO_fdopen(fd, "w+");
+ if (f) {
+ PerlLIO_unlink(SvPVX(sv));
+ SvREFCNT_dec(sv);
+ }
+ }
+# else
+ FILE *stdio = PerlSIO_tmpfile();
+ if (stdio) {
+ if ((f = PerlIO_push(aTHX_(PerlIO_allocate(aTHX)),
+ &PerlIO_stdio, "w+", Nullsv))) {
+ PerlIOStdio *s = PerlIOSelf(f, PerlIOStdio);
+ s->stdio = stdio;
+ }
+ }
+# endif /* HAS_MKSTEMP */
+#else
+ /* We have internal glob, which probably also means that we
+ * can also use File::Temp (which uses Fcntl) with impunity. */
+ GV *gv = gv_fetchpv("File::Temp::tempfile", FALSE, SVt_PVCV);
+
+ if (!gv) {
+ ENTER;
+ Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT,
+ newSVpvn("File::Temp", 10), Nullsv, Nullsv, Nullsv);
+ gv = gv_fetchpv("File::Temp::tempfile", FALSE, SVt_PVCV);
+ GvIMPORTED_CV_on(gv);
+ LEAVE;
+ }
+ if (gv && GvCV(gv)) {
+ dSP;
+ ENTER;
+ SAVETMPS;
+ PUSHMARK(SP);
+ PUTBACK;
+ if (call_sv((SV*)GvCV(gv), G_SCALAR)) {
+ GV *gv = (GV*)SvRV(newSVsv(*PL_stack_sp--));
+ IO *io = gv ? GvIO(gv) : 0;
+ fd = io ? PerlIO_fileno(IoIFP(io)) : -1;
+ }
+ SPAGAIN;
+ PUTBACK;
+ FREETMPS;
+ LEAVE;
+ }
+ if (fd >= 0)
+ f = PerlIO_fdopen(fd, "w+");
+#endif
+
+ return f;
+}
+
==== //depot/perl/perlio.c#220 (text) ====
Index: perl/perlio.c
--- perl/perlio.c#219~19655~ Sun Jun 1 23:54:05 2003
+++ perl/perlio.c Mon Jun 2 01:28:51 2003
@@ -4814,42 +4814,10 @@
PerlIO *
PerlIO_tmpfile(void)
{
- dTHX;
- PerlIO *f = NULL;
- int fd = -1;
- GV *gv = gv_fetchpv("File::Temp::tempfile", FALSE, SVt_PVCV);
-
- if (!gv) {
- ENTER;
- Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT,
- newSVpvn("File::Temp", 10), Nullsv, Nullsv, Nullsv);
- gv = gv_fetchpv("File::Temp::tempfile", FALSE, SVt_PVCV);
- GvIMPORTED_CV_on(gv);
- LEAVE;
- }
-
- if (gv && GvCV(gv)) {
- dSP;
- ENTER;
- SAVETMPS;
- PUSHMARK(SP);
- PUTBACK;
- if (call_sv((SV*)GvCV(gv), G_SCALAR)) {
- GV *gv = (GV*)SvRV(newSVsv(*PL_stack_sp--));
- IO *io = gv ? GvIO(gv) : 0;
- fd = io ? PerlIO_fileno(IoIFP(io)) : -1;
- }
- SPAGAIN;
- PUTBACK;
- FREETMPS;
- LEAVE;
- }
-
- if (fd >= 0) {
- f = PerlIO_fdopen(fd, "w+");
- if (f)
- PerlIOBase(f)->flags |= PERLIO_F_TEMP;
- }
+ PerlIO *f = Perl_my_tmpfp();
+
+ if (f)
+ PerlIOBase(f)->flags |= PERLIO_F_TEMP;
return f;
}
@@ -4980,11 +4948,3 @@
return result;
}
#endif
-
-
-
-
-
-
-
-
==== //depot/perl/proto.h#440 (text+w) ====
Index: perl/proto.h
--- perl/proto.h#439~19637~ Thu May 29 11:47:40 2003
+++ perl/proto.h Mon Jun 2 01:28:51 2003
@@ -920,6 +920,8 @@
PERL_CALLCONV void Perl_sv_nounlocking(pTHX_ SV *);
PERL_CALLCONV int Perl_nothreadhook(pTHX);
+PERL_CALLCONV PerlIO* Perl_my_tmpfp(pTHX);
+
END_EXTERN_C
#if defined(PERL_IN_DOOP_C) || defined(PERL_DECL_PROT)
End of Patch.
