Perl_pp_symlink and Perl_pp_link can be merged. The diff looks evil,

but the actual finished code is not as bad as it seems.

p4raw-id: //depot/perl@25972

diff --git a/mathoms.c b/mathoms.c
index 6596037..2fcf5f5 100644 (file)
--- a/mathoms.c
+++ b/mathoms.c
@@ -941,6 +941,11 @@ PP(pp_kill)
     return pp_chown();
 }
 
+PP(pp_symlink)
+{
+    return pp_link();
+}
+
 U8 *
 Perl_uvuni_to_utf8(pTHX_ U8 *d, UV uv)
 {

diff --git a/opcode.h b/opcode.h
index 196f0ec..7d7c7b4 100644 (file)
--- a/opcode.h
+++ b/opcode.h
@@ -1037,7 +1037,7 @@ EXT Perl_ppaddr_t PL_ppaddr[] /* or perlvars.h */
        MEMBER_TO_FPTR(Perl_pp_chown),  /* Perl_pp_utime */
        MEMBER_TO_FPTR(Perl_pp_rename),
        MEMBER_TO_FPTR(Perl_pp_link),
-       MEMBER_TO_FPTR(Perl_pp_symlink),
+       MEMBER_TO_FPTR(Perl_pp_link),   /* Perl_pp_symlink */
        MEMBER_TO_FPTR(Perl_pp_readlink),
        MEMBER_TO_FPTR(Perl_pp_mkdir),
        MEMBER_TO_FPTR(Perl_pp_rmdir),

diff --git a/opcode.pl b/opcode.pl
index 921324c..27cf87b 100755 (executable)
--- a/opcode.pl
+++ b/opcode.pl
@@ -69,6 +69,7 @@ my @raw_alias = (
                 Perl_pp_ggrent => [qw(ggrnam ggrgid)],
                 Perl_pp_ftis => [qw(ftsize ftmtime ftatime ftctime)],
                 Perl_pp_chown => [qw(unlink chmod utime kill)],
+                Perl_pp_link => ['symlink'],
                );
 
 while (my ($func, $names) = splice @raw_alias, 0, 2) {

diff --git a/pp_sys.c b/pp_sys.c
index d2a9618..276fa67 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -3501,33 +3501,54 @@ PP(pp_rename)
     RETURN;
 }
 
+#if defined(HAS_LINK) || defined(HAS_SYMLINK)
 PP(pp_link)
 {
-#ifdef HAS_LINK
     dSP; dTARGET;
-    const char *tmps2 = POPpconstx;
-    const char *tmps = SvPV_nolen_const(TOPs);
-    TAINT_PROPER("link");
-    SETi( PerlLIO_link(tmps, tmps2) >= 0 );
-    RETURN;
-#else
-    DIE(aTHX_ PL_no_func, "link");
-#endif
-}
+    const int op_type = PL_op->op_type;
+    int result;
 
-PP(pp_symlink)
-{
-#ifdef HAS_SYMLINK
-    dSP; dTARGET;
-    const char *tmps2 = POPpconstx;
-    const char *tmps = SvPV_nolen_const(TOPs);
-    TAINT_PROPER("symlink");
-    SETi( symlink(tmps, tmps2) >= 0 );
+#  ifndef HAS_LINK
+    if (op_type == OP_LINK)
+       DIE(aTHX_ PL_no_func, "link");
+#  endif
+#  ifndef HAS_SYMLINK
+    if (op_type == OP_SYMLINK)
+       DIE(aTHX_ PL_no_func, "symlink");
+#  endif
+
+    {
+       const char *tmps2 = POPpconstx;
+       const char *tmps = SvPV_nolen_const(TOPs);
+       TAINT_PROPER(PL_op_desc[op_type]);
+       result =
+#  if defined(HAS_LINK)
+#    if defined(HAS_SYMLINK)
+           /* Both present - need to choose which.  */
+           (op_type == OP_LINK) ?
+           PerlLIO_link(tmps, tmps2) : symlink(tmps, tmps2);
+#    else
+    /* Only have symlink, so calls to pp_link will have DIE()d above.  */
+       symlink(tmps, tmps2);
+#    endif
+#  else
+#    if defined(HAS_SYMLINK)
+    /* Only have link, so calls to pp_symlink will have DIE()d above.  */
+       PerlLIO_link(tmps, tmps2);
+#    endif
+#  endif
+    }
+
+    SETi( result >= 0 );
     RETURN;
+}
 #else
-    DIE(aTHX_ PL_no_func, "symlink");
-#endif
+PP(pp_link)
+{
+    /* Have neither.  */
+    DIE(aTHX_ PL_no_func, PL_op_desc[PL_op->op_type]);
 }
+#endif
 
 PP(pp_readlink)
 {