Change 23602: Pull out the duplicateded push @INC, $_ if -e $_ code from

[Nicholas Clark]

Change 23602 by [EMAIL PROTECTED] on 2004/12/03 15:50:15

        Pull out the duplicateded push @INC, $_ if -e $_ code from
        S_pushinc into a new function S_pushinc_if_exists
        Avoid the SV copy when pushing onto @INC by creating a new scratch
        SV each time a push is done.

Affected files ...

... //depot/perl/perl.c#568 edit

Differences ...

==== //depot/perl/perl.c#568 (text) ====
Index: perl/perl.c
--- perl/perl.c#567~23584~      Wed Dec  1 05:44:24 2004
+++ perl/perl.c Fri Dec  3 07:50:15 2004
@@ -4285,6 +4285,21 @@
 #  define PERLLIB_MANGLE(s,n) (s)
 #endif
 
+/* Push a directory onto @INC if it exists.
+   Generate a new SV if we do this, to save needing to copy the SV we push
+   onto @INC  */
+STATIC SV *
+S_incpush_if_exists(pTHX_ SV *dir)
+{
+    Stat_t tmpstatbuf;
+    if (PerlLIO_stat(SvPVX(dir), &tmpstatbuf) >= 0 &&
+       S_ISDIR(tmpstatbuf.st_mode)) {
+       av_push(GvAVn(PL_incgv), dir);
+       dir = NEWSV(0,0);
+    }
+    return dir;
+}
+
 STATIC void
 S_incpush(pTHX_ char *p, int addsubdirs, int addoldvers, int usesep)
 {
@@ -4294,7 +4309,7 @@
        return;
 
     if (addsubdirs || addoldvers) {
-       subdir = sv_newmortal();
+       subdir = NEWSV(0,0);
     }
 
     /* Break at all separators */
@@ -4340,7 +4355,6 @@
            const char *incverlist[] = { PERL_INC_VERSION_LIST };
            const char **incver;
 #endif
-           Stat_t tmpstatbuf;
 #ifdef VMS
            char *unix;
            STRLEN len;
@@ -4370,23 +4384,18 @@
                                libdir,
                               (int)PERL_REVISION, (int)PERL_VERSION,
                               (int)PERL_SUBVERSION, ARCHNAME);
-               if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 &&
-                     S_ISDIR(tmpstatbuf.st_mode))
-                   av_push(GvAVn(PL_incgv), newSVsv(subdir));
+               subdir = S_incpush_if_exists(aTHX_ subdir);
 
                /* .../version if -d .../version */
                Perl_sv_setpvf(aTHX_ subdir, "%"SVf PERL_ARCH_FMT_PATH, libdir,
                               (int)PERL_REVISION, (int)PERL_VERSION,
                               (int)PERL_SUBVERSION);
-               if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 &&
-                     S_ISDIR(tmpstatbuf.st_mode))
-                   av_push(GvAVn(PL_incgv), newSVsv(subdir));
+               subdir = S_incpush_if_exists(aTHX_ subdir);
 
                /* .../archname if -d .../archname */
                Perl_sv_setpvf(aTHX_ subdir, "%"SVf PERL_ARCH_FMT, libdir, 
ARCHNAME);
-               if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 &&
-                     S_ISDIR(tmpstatbuf.st_mode))
-                   av_push(GvAVn(PL_incgv), newSVsv(subdir));
+               subdir = S_incpush_if_exists(aTHX_ subdir);
+
            }
 
 #ifdef PERL_INC_VERSION_LIST
@@ -4394,9 +4403,7 @@
                for (incver = incverlist; *incver; incver++) {
                    /* .../xxx if -d .../xxx */
                    Perl_sv_setpvf(aTHX_ subdir, "%"SVf PERL_ARCH_FMT, libdir, 
*incver);
-                   if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 &&
-                         S_ISDIR(tmpstatbuf.st_mode))
-                       av_push(GvAVn(PL_incgv), newSVsv(subdir));
+                   subdir = S_incpush_if_exists(aTHX_ subdir);
                }
            }
 #endif
@@ -4404,6 +4411,10 @@
 
        /* finally push this lib directory on the end of @INC */
        av_push(GvAVn(PL_incgv), libdir);
+    }
+    if (subdir) {
+       assert (SvREFCNT(subdr) == 1);
+       SvREFCNT_dec(subdir);
     }
 }
 
End of Patch.