#endif
#if !defined(PERL_EFF_ACCESS) && defined(HAS_ACCESSX) && defined(ACC_SELF)
- /* AIX */
-# define PERL_EFF_ACCESS(p,f) (accessx((p), (f), ACC_SELF))
+ /* AIX's accessx() doesn't declare its argument const, unlike every other platform */
+# define PERL_EFF_ACCESS(p,f) (accessx((char*)(p), (f), ACC_SELF))
#endif
}
}
}
- else if (SvPOK(errsv) && SvCUR(errsv)) {
+ else if (SvOK(errsv) && (SvPV_nomg(errsv,len), len)) {
exsv = sv_mortalcopy(errsv);
sv_catpvs(exsv, "\t...propagated");
}
/*
-=head1 GV Functions
+=for apidoc_section $GV
=for apidoc setdefout
if ((fp_utf8 = PerlIO_isutf8(IoIFP(io))) && !IN_BYTES) {
if (PL_op->op_type == OP_SYSREAD || PL_op->op_type == OP_RECV) {
- Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED),
- "%s() is deprecated on :utf8 handles. "
- "This will be a fatal error in Perl 5.30",
- OP_DESC(PL_op));
+ Perl_croak(aTHX_
+ "%s() isn't allowed on :utf8 handles",
+ OP_DESC(PL_op));
}
buffer = SvPVutf8_force(bufsv, blen);
/* UTF-8 may not have been set if they are all low bytes */
}
else {
buffer = SvPV_force(bufsv, blen);
- buffer_utf8 = !IN_BYTES && SvUTF8(bufsv);
+ buffer_utf8 = DO_UTF8(bufsv);
}
if (DO_UTF8(bufsv)) {
blen = sv_len_utf8_nomg(bufsv);
const char *buffer;
SSize_t retval;
STRLEN blen;
- STRLEN orig_blen_bytes;
const int op_type = PL_op->op_type;
bool doing_utf8;
U8 *tmpbuf = NULL;
/* Do this first to trigger any overloading. */
buffer = SvPV_const(bufsv, blen);
- orig_blen_bytes = blen;
doing_utf8 = DO_UTF8(bufsv);
if (PerlIO_isutf8(IoIFP(io))) {
- Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED),
- "%s() is deprecated on :utf8 handles. "
- "This will be a fatal error in Perl 5.30",
- OP_DESC(PL_op));
- if (!SvUTF8(bufsv)) {
- /* We don't modify the original scalar. */
- tmpbuf = bytes_to_utf8((const U8*) buffer, &blen);
- buffer = (char *) tmpbuf;
- doing_utf8 = TRUE;
- }
+ Perl_croak(aTHX_
+ "%s() isn't allowed on :utf8 handles",
+ OP_DESC(PL_op));
}
else if (doing_utf8) {
STRLEN tmplen = blen;
#endif
{
Size_t length = 0; /* This length is in characters. */
- STRLEN blen_chars;
IV offset;
- if (doing_utf8) {
- if (tmpbuf) {
- /* The SV is bytes, and we've had to upgrade it. */
- blen_chars = orig_blen_bytes;
- } else {
- /* The SV really is UTF-8. */
- /* Don't call sv_len_utf8 on a magical or overloaded
- scalar, as we might get back a different result. */
- blen_chars = sv_or_pv_len_utf8(bufsv, buffer, blen);
- }
- } else {
- blen_chars = blen;
- }
-
if (MARK >= SP) {
- length = blen_chars;
+ length = blen;
} else {
#if Size_t_size > IVSIZE
length = (Size_t)SvNVx(*++MARK);
if (MARK < SP) {
offset = SvIVx(*++MARK);
if (offset < 0) {
- if (-offset > (IV)blen_chars) {
+ if (-offset > (IV)blen) {
Safefree(tmpbuf);
DIE(aTHX_ "Offset outside string");
}
- offset += blen_chars;
- } else if (offset > (IV)blen_chars) {
+ offset += blen;
+ } else if (offset > (IV)blen) {
Safefree(tmpbuf);
DIE(aTHX_ "Offset outside string");
}
} else
offset = 0;
- if (length > blen_chars - offset)
- length = blen_chars - offset;
- if (doing_utf8) {
- /* Here we convert length from characters to bytes. */
- if (tmpbuf || SvGMAGICAL(bufsv) || SvAMAGIC(bufsv)) {
- /* Either we had to convert the SV, or the SV is magical, or
- the SV has overloading, in which case we can't or mustn't
- or mustn't call it again. */
-
- buffer = (const char*)utf8_hop((const U8 *)buffer, offset);
- length = utf8_hop((U8 *)buffer, length) - (U8 *)buffer;
- } else {
- /* It's a real UTF-8 SV, and it's not going to change under
- us. Take advantage of any cache. */
- I32 start = offset;
- I32 len_I32 = length;
-
- /* Convert the start and end character positions to bytes.
- Remember that the second argument to sv_pos_u2b is relative
- to the first. */
- sv_pos_u2b(bufsv, &start, &len_I32);
-
- buffer += start;
- length = len_I32;
- }
- }
- else {
- buffer = buffer+offset;
- }
+ if (length > blen - offset)
+ length = blen - offset;
+ buffer = buffer+offset;
+
#ifdef PERL_SOCK_SYSWRITE_IS_SEND
if (IoTYPE(io) == IoTYPE_SOCKET) {
retval = PerlSock_send(fd, buffer, length, 0);
if (retval < 0)
goto say_undef;
SP = ORIGMARK;
- if (doing_utf8)
- retval = utf8_length((U8*)buffer, (U8*)buffer + retval);
Safefree(tmpbuf);
#if Size_t_size > IVSIZE
}
if (!gv)
- RETPUSHNO;
+ RETPUSHYES;
if ((io = GvIO(gv)) && (mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar))) {
return tied_method1(SV_CONST(EOF), SP, MUTABLE_SV(io), mg, newSVuv(which));
if (!MAXARG && (PL_op->op_flags & OPf_SPECIAL)) { /* eof() */
if (io && !IoIFP(io)) {
- if ((IoFLAGS(io) & IOf_START) && av_tindex(GvAVn(gv)) < 0) {
+ if ((IoFLAGS(io) & IOf_START) && av_count(GvAVn(gv)) == 0) {
SV ** svp;
IoLINES(io) = 0;
IoFLAGS(io) &= ~IOf_START;
}
#if LSEEKSIZE > IVSIZE
- PUSHn( do_tell(gv) );
+ PUSHn( (NV)do_tell(gv) );
#else
- PUSHi( do_tell(gv) );
+ PUSHi( (IV)do_tell(gv) );
#endif
RETURN;
}
PUSHs(sv);
break;
case OP_SSOCKOPT: {
-#if defined(__SYMBIAN32__)
-# define SETSOCKOPT_OPTION_VALUE_T void *
-#else
-# define SETSOCKOPT_OPTION_VALUE_T const char *
-#endif
- /* XXX TODO: We need to have a proper type (a Configure probe,
- * etc.) for what the C headers think of the third argument of
- * setsockopt(), the option_value read-only buffer: is it
- * a "char *", or a "void *", const or not. Some compilers
- * don't take kindly to e.g. assuming that "char *" implicitly
- * promotes to a "void *", or to explicitly promoting/demoting
- * consts to non/vice versa. The "const void *" is the SUS
- * definition, but that does not fly everywhere for the above
- * reasons. */
- SETSOCKOPT_OPTION_VALUE_T buf;
+ const char *buf;
int aint;
if (SvPOKp(sv)) {
STRLEN l;
- buf = (SETSOCKOPT_OPTION_VALUE_T) SvPV_const(sv, l);
+ buf = SvPV_const(sv, l);
len = l;
}
else {
aint = (int)SvIV(sv);
- buf = (SETSOCKOPT_OPTION_VALUE_T) &aint;
+ buf = (const char *) &aint;
len = sizeof(int);
}
if (PerlSock_setsockopt(fd, lvl, optname, buf, len) < 0)
if (!IoIFP(io))
goto nuts;
- sv = sv_2mortal(newSV(257));
- (void)SvPOK_only(sv);
+#ifdef HAS_SOCKADDR_STORAGE
+ len = sizeof(struct sockaddr_storage);
+#else
len = 256;
+#endif
+ sv = sv_2mortal(newSV(len+1));
+ (void)SvPOK_only(sv);
SvCUR_set(sv, len);
*SvEND(sv) ='\0';
fd = PerlIO_fileno(IoIFP(io));
SV *const arg = *PL_stack_sp;
assert(chr != '?');
- if (!(PL_op->op_private & OPpFT_STACKING)) SvGETMAGIC(arg);
+ if (!(PL_op->op_private & OPpFT_STACKED)) SvGETMAGIC(arg);
if (SvAMAGIC(arg))
{
len = readlink(tmps, buf, sizeof(buf) - 1);
if (len < 0)
RETPUSHUNDEF;
- if (len != -1)
- buf[len] = '\0';
+ buf[len] = '\0';
PUSHp(buf, len);
RETURN;
#else
result = 0;
if (PL_op->op_flags & OPf_STACKED) {
SV * const really = *++MARK;
-# if defined(WIN32) || defined(OS2) || defined(__SYMBIAN32__) || defined(__VMS)
+# if defined(WIN32) || defined(OS2) || defined(__VMS)
value = (I32)do_aspawn(really, MARK, SP);
# else
value = (I32)do_aspawn(really, (void **)MARK, (void **)SP);
# endif
}
else if (SP - MARK != 1) {
-# if defined(WIN32) || defined(OS2) || defined(__SYMBIAN32__) || defined(__VMS)
+# if defined(WIN32) || defined(OS2) || defined(__VMS)
value = (I32)do_aspawn(NULL, MARK, SP);
# else
value = (I32)do_aspawn(NULL, (void **)MARK, (void **)SP);
#endif
}
+/*
+ * The glibc headers typedef __priority_which_t to an enum under C, but
+ * under C++, it keeps it as int. -Wc++-compat doesn't know this, so we
+ * need to explicitly cast it to shut up the warning.
+ */
#if defined(__GLIBC__) && ((__GLIBC__ == 2 && __GLIBC_MINOR__ >= 3) || (__GLIBC__ > 2))
# define PRIORITY_WHICH_T(which) (__priority_which_t)which
#else
{
dSP; dTARGET;
#ifdef BIG_TIME
- XPUSHn( time(NULL) );
+ XPUSHn( (NV)time(NULL) );
#else
- XPUSHi( time(NULL) );
+ XPUSHu( (UV)time(NULL) );
#endif
RETURN;
}
}
}
(void)time(&when);
- XPUSHi(when - lasttime);
+ XPUSHu((UV)(when - lasttime));
RETURN;
}
DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]);
#endif
break;
-#ifdef HAS_SETNETENT
case OP_SNETENT:
+#ifdef HAS_SETNETENT
PerlSock_setnetent(stayopen);
#else
DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]);
* it is only included in special cases.
*
* In Digital UNIX/Tru64 if using the getespw*() (which seems to be
- * be preferred interface, even though also the getprpw*() interface
+ * the preferred interface, even though also the getprpw*() interface
* is available) one needs to link with -lsecurity -ldb -laud -lm.
* One also needs to call set_auth_parameters() in main() before
* doing anything else, whether one is using getespw*() or getprpw*().
https://perl5.git.perl.org / perl5.git / blobdiff