X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/d5713896ecd1399c9c6c4076514a33eb2880d8c3..e0ee75a6976f08f9bc3868227f1cd11ab6507895:/gv.c

diff --git a/gv.c b/gv.c
index d46b253..3df4e27 100644
--- a/gv.c
+++ b/gv.c
@@ -45,15 +45,34 @@ Perl_gv_add_by_type(pTHX_ GV *gv, svtype type)
 {
     SV **where;
 
-    PERL_ARGS_ASSERT_GV_ADD_BY_TYPE;
-
-    if (!gv || SvTYPE((const SV *)gv) != SVt_PVGV)
-	Perl_croak(aTHX_ "Bad symbol for %s", type == SVt_PVAV ? "array" : type == SVt_PVHV ? "hash" : "scalar");
+    if (!gv || SvTYPE((const SV *)gv) != SVt_PVGV) {
+	const char *what;
+	if (type == SVt_PVIO) {
+	    /*
+	     * if it walks like a dirhandle, then let's assume that
+	     * this is a dirhandle.
+	     */
+	    what = PL_op->op_type ==  OP_READDIR ||
+		PL_op->op_type ==  OP_TELLDIR ||
+		PL_op->op_type ==  OP_SEEKDIR ||
+		PL_op->op_type ==  OP_REWINDDIR ||
+		PL_op->op_type ==  OP_CLOSEDIR ?
+		"dirhandle" : "filehandle";
+	    /* diag_listed_as: Bad symbol for filehandle */
+	} else if (type == SVt_PVHV) {
+	    what = "hash";
+	} else {
+	    what = type == SVt_PVAV ? "array" : "scalar";
+	}
+	Perl_croak(aTHX_ "Bad symbol for %s", what);
+    }
 
     if (type == SVt_PVHV) {
 	where = (SV **)&GvHV(gv);
     } else if (type == SVt_PVAV) {
 	where = (SV **)&GvAV(gv);
+    } else if (type == SVt_PVIO) {
+	where = (SV **)&GvIOp(gv);
     } else {
 	where = &GvSV(gv);
     }
@@ -64,34 +83,6 @@ Perl_gv_add_by_type(pTHX_ GV *gv, svtype type)
 }
 
 GV *
-Perl_gv_IOadd(pTHX_ register GV *gv)
-{
-    dVAR;
-
-    if (!gv || SvTYPE((const SV *)gv) != SVt_PVGV) {
-
-        /*
-         * if it walks like a dirhandle, then let's assume that
-         * this is a dirhandle.
-         */
-	const char * const fh =
-			 PL_op->op_type ==  OP_READDIR ||
-                         PL_op->op_type ==  OP_TELLDIR ||
-                         PL_op->op_type ==  OP_SEEKDIR ||
-                         PL_op->op_type ==  OP_REWINDDIR ||
-                         PL_op->op_type ==  OP_CLOSEDIR ?
-                         "dirhandle" : "filehandle";
-	/* diag_listed_as: Bad symbol for filehandle */
-        Perl_croak(aTHX_ "Bad symbol for %s", fh);
-    }
-
-    if (!GvIOp(gv)) {
-	GvIOp(gv) = newIO();
-    }
-    return gv;
-}
-
-GV *
 Perl_gv_fetchfile(pTHX_ const char *name)
 {
     PERL_ARGS_ASSERT_GV_FETCHFILE;
@@ -864,17 +855,18 @@ Perl_gv_stashpvn(pTHX_ const char *name, U32 namelen, I32 flags)
     char *tmpbuf;
     HV *stash;
     GV *tmpgv;
+    U32 tmplen = namelen + 2;
 
     PERL_ARGS_ASSERT_GV_STASHPVN;
 
-    if (namelen + 2 <= sizeof smallbuf)
+    if (tmplen <= sizeof smallbuf)
 	tmpbuf = smallbuf;
     else
-	Newx(tmpbuf, namelen + 2, char);
-    Copy(name,tmpbuf,namelen,char);
-    tmpbuf[namelen++] = ':';
-    tmpbuf[namelen++] = ':';
-    tmpgv = gv_fetchpvn_flags(tmpbuf, namelen, flags, SVt_PVHV);
+	Newx(tmpbuf, tmplen, char);
+    Copy(name, tmpbuf, namelen, char);
+    tmpbuf[namelen]   = ':';
+    tmpbuf[namelen+1] = ':';
+    tmpgv = gv_fetchpvn_flags(tmpbuf, tmplen, flags, SVt_PVHV);
     if (tmpbuf != smallbuf)
 	Safefree(tmpbuf);
     if (!tmpgv)
@@ -1485,27 +1477,6 @@ Perl_gv_efullname4(pTHX_ SV *sv, const GV *gv, const char *prefix, bool keepmain
     gv_fullname4(sv, egv ? egv : gv, prefix, keepmain);
 }
 
-IO *
-Perl_newIO(pTHX)
-{
-    dVAR;
-    GV *iogv;
-    IO * const io = MUTABLE_IO(newSV_type(SVt_PVIO));
-    /* This used to read SvREFCNT(io) = 1;
-       It's not clear why the reference count needed an explicit reset. NWC
-    */
-    assert (SvREFCNT(io) == 1);
-    SvOBJECT_on(io);
-    /* Clear the stashcache because a new IO could overrule a package name */
-    hv_clear(PL_stashcache);
-    iogv = gv_fetchpvs("FileHandle::", 0, SVt_PVHV);
-    /* unless exists($main::{FileHandle}) and defined(%main::FileHandle::) */
-    if (!(iogv && GvHV(iogv) && HvARRAY(GvHV(iogv))))
-      iogv = gv_fetchpvs("IO::Handle::", GV_ADD, SVt_PVHV);
-    SvSTASH_set(io, MUTABLE_HV(SvREFCNT_inc(GvHV(iogv))));
-    return io;
-}
-
 void
 Perl_gv_check(pTHX_ const HV *stash)
 {