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

4 files changed, 48 insertions, 21 deletions

diff --git a/mathoms.c b/mathoms.c
index 659603769b..2fcf5f561e 100644
--- 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 196f0ec3f1..7d7c7b4148 100644
--- 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 921324c325..27cf87b539 100755
--- 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 d2a961833c..276fa67f72 100644
--- 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)
 {