PERL_ARGS_ASSERT_TIED_METHOD;
/* Ensure that our flag bits do not overlap. */
- assert((TIED_METHOD_MORTALIZE_NOT_NEEDED & G_WANT) == 0);
- assert((TIED_METHOD_ARGUMENTS_ON_STACK & G_WANT) == 0);
- assert((TIED_METHOD_SAY & G_WANT) == 0);
+ STATIC_ASSERT_STMT((TIED_METHOD_MORTALIZE_NOT_NEEDED & G_WANT) == 0);
+ STATIC_ASSERT_STMT((TIED_METHOD_ARGUMENTS_ON_STACK & G_WANT) == 0);
+ STATIC_ASSERT_STMT((TIED_METHOD_SAY & G_WANT) == 0);
PUTBACK; /* sp is at *foot* of args, so this pops args from old stack */
PUSHSTACKi(PERLSI_MAGIC);
return tied_method0(SV_CONST(FILENO), SP, MUTABLE_SV(io), mg);
}
+ if (io && IoDIRP(io)) {
+#if defined(HAS_DIRFD) || defined(HAS_DIR_DD_FD)
+ PUSHi(my_dirfd(IoDIRP(io)));
+ RETURN;
+#elif defined(ENOTSUP)
+ errno = ENOTSUP; /* Operation not supported */
+ RETPUSHUNDEF;
+#elif defined(EOPNOTSUPP)
+ errno = EOPNOTSUPP; /* Operation not supported on socket */
+ RETPUSHUNDEF;
+#else
+ errno = EINVAL; /* Invalid argument */
+ RETPUSHUNDEF;
+#endif
+ }
+
if (!io || !(fp = IoIFP(io))) {
/* Can't do this because people seem to do things like
defined(fileno($foo)) to check whether $foo is a valid fh.
RETURN;
}
+
+/* also used for: pp_dbmclose() */
+
PP(pp_untie)
{
dSP;
RETURN;
}
+
+/* also used for: pp_read() and pp_recv() (where supported) */
+
PP(pp_sysread)
{
dSP; dMARK; dORIGMARK; dTARGET;
bytes from a byte file handle into a UTF8 buffer, but it won't harm us
unduly.
(should be 2 * length + offset + 1, or possibly something longer if
- PL_encoding is true) */
+ IN_ENCODING Is true) */
buffer = SvGROW(bufsv, (STRLEN)(length+offset+1));
if (offset > 0 && offset > (SSize_t)orig_size) { /* Zero any newly allocated space */
Zero(buffer+orig_size, offset-orig_size, char);
RETPUSHUNDEF;
}
+
+/* also used for: pp_send() where defined */
+
PP(pp_syswrite)
{
dSP; dMARK; dORIGMARK; dTARGET;
if (!MAXARG && (PL_op->op_flags & OPf_SPECIAL)) { /* eof() */
if (io && !IoIFP(io)) {
if ((IoFLAGS(io) & IOf_START) && av_tindex(GvAVn(gv)) < 0) {
+ SV ** svp;
IoLINES(io) = 0;
IoFLAGS(io) &= ~IOf_START;
do_open6(gv, "-", 1, NULL, NULL, 0);
- if (GvSV(gv))
- sv_setpvs(GvSV(gv), "-");
+ svp = &GvSV(gv);
+ if (*svp) {
+ SV * sv = *svp;
+ sv_setpvs(sv, "-");
+ SvSETMAGIC(sv);
+ }
else
- GvSV(gv) = newSVpvs("-");
- SvSETMAGIC(GvSV(gv));
+ *svp = newSVpvs("-");
}
- else if (!nextargv(gv))
+ else if (!nextargv(gv, FALSE))
RETPUSHYES;
}
}
RETURN;
}
+
+/* also used for: pp_seek() */
+
PP(pp_sysseek)
{
dSP;
}
}
+
+/* also used for: pp_fcntl() */
+
PP(pp_ioctl)
{
dSP; dTARGET;
#ifdef HAS_SOCKET
+/* also used for: pp_connect() */
+
PP(pp_bind)
{
dSP;
RETPUSHUNDEF;
}
+
+/* also used for: pp_gsockopt() */
+
PP(pp_ssockopt)
{
dSP;
len = SvCUR(sv);
if (PerlSock_getsockopt(fd, lvl, optname, SvPVX(sv), &len) < 0)
goto nuts2;
+#if defined(_AIX)
+ /* XXX Configure test: does getsockopt set the length properly? */
+ if (len == 256)
+ len = sizeof(int);
+#endif
SvCUR_set(sv, len);
*SvEND(sv) ='\0';
PUSHs(sv);
}
+
+/* also used for: pp_getsockname() */
+
PP(pp_getpeername)
{
dSP;
/* Stat calls. */
+/* also used for: pp_lstat() */
+
PP(pp_stat)
{
dSP;
}
+/* also used for: pp_fteexec() pp_fteread() pp_ftewrite() pp_ftrexec()
+ * pp_ftrwrite() */
+
PP(pp_ftrread)
{
I32 result;
/* Not const, because things tweak this below. Not bool, because there's
- no guarantee that OPp_FT_ACCESS is <= CHAR_MAX */
+ no guarantee that OPpFT_ACCESS is <= CHAR_MAX */
#if defined(HAS_ACCESS) || defined (PERL_EFF_ACCESS)
I32 use_access = PL_op->op_private & OPpFT_ACCESS;
/* Giving some sort of initial value silences compilers. */
FT_RETURNNO;
}
+
+/* also used for: pp_ftatime() pp_ftctime() pp_ftmtime() pp_ftsize() */
+
PP(pp_ftis)
{
I32 result;
}
}
+
+/* also used for: pp_ftblk() pp_ftchr() pp_ftdir() pp_fteowned()
+ * pp_ftfile() pp_ftpipe() pp_ftsgid() pp_ftsock()
+ * pp_ftsuid() pp_ftsvtx() pp_ftzero() */
+
PP(pp_ftrowned)
{
I32 result;
FT_RETURNNO;
}
+
+/* also used for: pp_ftbinary() */
+
PP(pp_fttext)
{
I32 i;
}
/* now scan s to look for textiness */
- /* XXX ASCII dependent code */
#if defined(DOSISH) || defined(USEMYBINMODE)
/* ignore trailing ^Z on short files */
--len;
#endif
+ assert(len);
+ if (! is_invariant_string((U8 *) s, len)) {
+ const U8 *ep;
+
+ /* Here contains a variant under UTF-8 . See if the entire string is
+ * UTF-8. But the buffer may end in a partial character, so consider
+ * it UTF-8 if the first non-UTF8 char is an ending partial */
+ if (is_utf8_string_loc((U8 *) s, len, &ep)
+ || ep + UTF8SKIP(ep) > (U8 *) (s + len))
+ {
+ if (PL_op->op_type == OP_FTTEXT) {
+ FT_RETURNYES;
+ }
+ else {
+ FT_RETURNNO;
+ }
+ }
+ }
+
+ /* Here, is not UTF-8 or is entirely ASCII. Look through the buffer for
+ * things that wouldn't be in ASCII text or rich ASCII text. Count these
+ * in 'odd' */
for (i = 0; i < len; i++, s++) {
if (!*s) { /* null never allowed in text */
odd += len;
break;
}
-#ifdef EBCDIC
- else if (!(isPRINT(*s) || isSPACE(*s)))
- odd++;
-#else
- else if (*s & 128) {
#ifdef USE_LOCALE_CTYPE
- if (IN_LC_RUNTIME(LC_CTYPE) && isALPHA_LC(*s))
+ if (IN_LC_RUNTIME(LC_CTYPE)) {
+ if ( isPRINT_LC(*s) || isSPACE_LC(*s)) {
continue;
+ }
+ }
+ else
#endif
- /* utf8 characters don't count as odd */
- if (UTF8_IS_START(*s)) {
- int ulen = UTF8SKIP(s);
- if (ulen < len - i) {
- int j;
- for (j = 1; j < ulen; j++) {
- if (!UTF8_IS_CONTINUATION(s[j]))
- goto not_utf8;
- }
- --ulen; /* loop does extra increment */
- s += ulen;
- i += ulen;
- continue;
- }
- }
- not_utf8:
- odd++;
- }
- else if (*s < 32 &&
- *s != '\n' && *s != '\r' && *s != '\b' &&
- *s != '\t' && *s != '\f' && *s != 27)
- odd++;
-#endif
+ if (isPRINT_A(*s)
+ /* VT occurs so rarely in text, that we consider it odd */
+ || (isSPACE_A(*s) && *s != VT_NATIVE)
+
+ /* But there is a fair amount of backspaces and escapes in
+ * some text */
+ || *s == '\b'
+ || *s == ESC_NATIVE)
+ {
+ continue;
+ }
+ odd++;
}
if ((odd * 3 > len) == (PL_op->op_type == OP_FTTEXT)) /* allow 1/3 odd */
RETURN;
}
+
+/* also used for: pp_chmod() pp_kill() pp_unlink() pp_utime() */
+
PP(pp_chown)
{
dSP; dMARK; dTARGET;
RETURN;
}
+
+/* also used for: pp_symlink() */
+
#if defined(HAS_LINK) || defined(HAS_SYMLINK)
PP(pp_link)
{
RETURN;
}
#else
+
+/* also used for: pp_symlink() */
+
PP(pp_link)
{
/* Have neither. */
Pid_t pgrp;
Pid_t pid;
pgrp = MAXARG == 2 && (TOPs||POPs) ? POPi : 0;
- if (MAXARG > 0) pid = TOPs && TOPi;
+ if (MAXARG > 0) pid = TOPs ? TOPi : 0;
else {
pid = 0;
- XPUSHi(-1);
+ EXTEND(SP,1);
+ SP++;
}
TAINT_PROPER("setpgrp");
/* Sun Dec 29 12:00:00 2147483647 */
#define TIME_UPPER_BOUND 67767976233316800.0
+
+/* also used for: pp_localtime() */
+
PP(pp_gmtime)
{
dSP;
if (err == NULL)
RETPUSHUNDEF;
else {
- mPUSHs(Perl_newSVpvf(aTHX_ "%s %s %2d %02d:%02d:%02d %.0f",
+ mPUSHs(Perl_newSVpvf(aTHX_ "%s %s %2d %02d:%02d:%02d %"IVdf,
dayname[tmbuf.tm_wday],
monname[tmbuf.tm_mon],
tmbuf.tm_mday,
tmbuf.tm_hour,
tmbuf.tm_min,
tmbuf.tm_sec,
- /* XXX newSVpvf()'s %lld type is broken,
- * so cheat with a double */
- (double)tmbuf.tm_year + 1900));
+ (IV)tmbuf.tm_year + 1900));
}
}
else { /* list context */
/* Shared memory. */
/* Merged with some message passing. */
+/* also used for: pp_msgrcv() pp_msgsnd() pp_semop() pp_shmread() */
+
PP(pp_shmwrite)
{
#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
/* Semaphores. */
+/* also used for: pp_msgget() pp_shmget() */
+
PP(pp_semget)
{
#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
#endif
}
+/* also used for: pp_msgctl() pp_shmctl() */
+
PP(pp_semctl)
{
#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
const int anum = do_ipcctl(PL_op->op_type, MARK, SP);
SP = MARK;
if (anum == -1)
- RETSETUNDEF;
+ RETPUSHUNDEF;
if (anum != 0) {
PUSHi(anum);
}
/* Get system info. */
+/* also used for: pp_ghbyaddr() pp_ghbyname() */
+
PP(pp_ghostent)
{
#if defined(HAS_GETHOSTBYNAME) || defined(HAS_GETHOSTBYADDR) || defined(HAS_GETHOSTENT)
#endif
}
+/* also used for: pp_gnbyaddr() pp_gnbyname() */
+
PP(pp_gnetent)
{
#if defined(HAS_GETNETBYNAME) || defined(HAS_GETNETBYADDR) || defined(HAS_GETNETENT)
#endif
}
+
+/* also used for: pp_gpbyname() pp_gpbynumber() */
+
PP(pp_gprotoent)
{
#if defined(HAS_GETPROTOBYNAME) || defined(HAS_GETPROTOBYNUMBER) || defined(HAS_GETPROTOENT)
#endif
}
+
+/* also used for: pp_gsbyname() pp_gsbyport() */
+
PP(pp_gservent)
{
#if defined(HAS_GETSERVBYNAME) || defined(HAS_GETSERVBYPORT) || defined(HAS_GETSERVENT)
#endif
}
+
+/* also used for: pp_snetent() pp_sprotoent() pp_sservent() */
+
PP(pp_shostent)
{
dSP;
RETSETYES;
}
+
+/* also used for: pp_egrent() pp_enetent() pp_eprotoent() pp_epwent()
+ * pp_eservent() pp_sgrent() pp_spwent() */
+
PP(pp_ehostent)
{
dSP;
RETPUSHYES;
}
+
+/* also used for: pp_gpwnam() pp_gpwuid() */
+
PP(pp_gpwent)
{
#ifdef HAS_PASSWD
#endif
}
+
+/* also used for: pp_ggrgid() pp_ggrnam() */
+
PP(pp_ggrent)
{
#ifdef HAS_GROUP
https://perl5.git.perl.org / perl5.git / blobdiff