diff options
Diffstat (limited to 'contrib/perl5/ext/POSIX')
| -rw-r--r-- | contrib/perl5/ext/POSIX/Makefile.PL | 2 | ||||
| -rw-r--r-- | contrib/perl5/ext/POSIX/POSIX.pm | 110 | ||||
| -rw-r--r-- | contrib/perl5/ext/POSIX/POSIX.pod | 7 | ||||
| -rw-r--r-- | contrib/perl5/ext/POSIX/POSIX.xs | 73 | ||||
| -rw-r--r-- | contrib/perl5/ext/POSIX/hints/dynixptx.pl | 4 | ||||
| -rw-r--r-- | contrib/perl5/ext/POSIX/hints/mint.pl | 2 |
6 files changed, 131 insertions, 67 deletions
diff --git a/contrib/perl5/ext/POSIX/Makefile.PL b/contrib/perl5/ext/POSIX/Makefile.PL index bc1dda9..d379fdb 100644 --- a/contrib/perl5/ext/POSIX/Makefile.PL +++ b/contrib/perl5/ext/POSIX/Makefile.PL @@ -2,7 +2,7 @@ use ExtUtils::MakeMaker; WriteMakefile( NAME => 'POSIX', ($^O eq 'MSWin32' ? () : (LIBS => ["-lm -lposix -lcposix"])), - MAN3PODS => ' ', # Pods will be built by installman. + MAN3PODS => {}, # Pods will be built by installman. XSPROTOARG => '-noprototypes', # XXX remove later? VERSION_FROM => 'POSIX.pm', ); diff --git a/contrib/perl5/ext/POSIX/POSIX.pm b/contrib/perl5/ext/POSIX/POSIX.pm index 5d3ef5c..84298cb 100644 --- a/contrib/perl5/ext/POSIX/POSIX.pm +++ b/contrib/perl5/ext/POSIX/POSIX.pm @@ -268,25 +268,25 @@ sub toupper { sub closedir { usage "closedir(dirhandle)" if @_ != 1; - closedir($_[0]); + CORE::closedir($_[0]); } sub opendir { usage "opendir(directory)" if @_ != 1; my $dirhandle = gensym; - opendir($dirhandle, $_[0]) + CORE::opendir($dirhandle, $_[0]) ? $dirhandle : undef; } sub readdir { usage "readdir(dirhandle)" if @_ != 1; - readdir($_[0]); + CORE::readdir($_[0]); } sub rewinddir { usage "rewinddir(dirhandle)" if @_ != 1; - rewinddir($_[0]); + CORE::rewinddir($_[0]); } sub errno { @@ -301,42 +301,42 @@ sub creat { sub fcntl { usage "fcntl(filehandle, cmd, arg)" if @_ != 3; - fcntl($_[0], $_[1], $_[2]); + CORE::fcntl($_[0], $_[1], $_[2]); } sub getgrgid { usage "getgrgid(gid)" if @_ != 1; - getgrgid($_[0]); + CORE::getgrgid($_[0]); } sub getgrnam { usage "getgrnam(name)" if @_ != 1; - getgrnam($_[0]); + CORE::getgrnam($_[0]); } sub atan2 { usage "atan2(x,y)" if @_ != 2; - atan2($_[0], $_[1]); + CORE::atan2($_[0], $_[1]); } sub cos { usage "cos(x)" if @_ != 1; - cos($_[0]); + CORE::cos($_[0]); } sub exp { usage "exp(x)" if @_ != 1; - exp($_[0]); + CORE::exp($_[0]); } sub fabs { usage "fabs(x)" if @_ != 1; - abs($_[0]); + CORE::abs($_[0]); } sub log { usage "log(x)" if @_ != 1; - log($_[0]); + CORE::log($_[0]); } sub pow { @@ -346,22 +346,22 @@ sub pow { sub sin { usage "sin(x)" if @_ != 1; - sin($_[0]); + CORE::sin($_[0]); } sub sqrt { usage "sqrt(x)" if @_ != 1; - sqrt($_[0]); + CORE::sqrt($_[0]); } sub getpwnam { usage "getpwnam(name)" if @_ != 1; - getpwnam($_[0]); + CORE::getpwnam($_[0]); } sub getpwuid { usage "getpwuid(uid)" if @_ != 1; - getpwuid($_[0]); + CORE::getpwuid($_[0]); } sub longjmp { @@ -382,12 +382,12 @@ sub sigsetjmp { sub kill { usage "kill(pid, sig)" if @_ != 2; - kill $_[1], $_[0]; + CORE::kill $_[1], $_[0]; } sub raise { usage "raise(sig)" if @_ != 1; - kill $_[0], $$; # Is this good enough? + CORE::kill $_[0], $$; # Is this good enough? } sub offsetof { @@ -480,12 +480,12 @@ sub fwrite { sub getc { usage "getc(handle)" if @_ != 1; - getc($_[0]); + CORE::getc($_[0]); } sub getchar { usage "getchar()" if @_ != 0; - getc(STDIN); + CORE::getc(STDIN); } sub gets { @@ -500,7 +500,7 @@ sub perror { sub printf { usage "printf(pattern, args...)" if @_ < 1; - printf STDOUT @_; + CORE::printf STDOUT @_; } sub putc { @@ -517,17 +517,17 @@ sub puts { sub remove { usage "remove(filename)" if @_ != 1; - unlink($_[0]); + CORE::unlink($_[0]); } sub rename { usage "rename(oldfilename, newfilename)" if @_ != 2; - rename($_[0], $_[1]); + CORE::rename($_[0], $_[1]); } sub rewind { usage "rewind(filehandle)" if @_ != 1; - seek($_[0],0,0); + CORE::seek($_[0],0,0); } sub scanf { @@ -536,7 +536,7 @@ sub scanf { sub sprintf { usage "sprintf(pattern,args)" if @_ == 0; - sprintf(shift,@_); + CORE::sprintf(shift,@_); } sub sscanf { @@ -565,7 +565,7 @@ sub vsprintf { sub abs { usage "abs(x)" if @_ != 1; - abs($_[0]); + CORE::abs($_[0]); } sub atexit { @@ -598,7 +598,7 @@ sub div { sub exit { usage "exit(status)" if @_ != 1; - exit($_[0]); + CORE::exit($_[0]); } sub free { @@ -640,7 +640,7 @@ sub srand { sub system { usage "system(command)" if @_ != 1; - system($_[0]); + CORE::system($_[0]); } sub memchr { @@ -719,7 +719,7 @@ sub strspn { sub strstr { usage "strstr(big, little)" if @_ != 2; - index($_[0], $_[1]); + CORE::index($_[0], $_[1]); } sub strtok { @@ -728,71 +728,71 @@ sub strtok { sub chmod { usage "chmod(mode, filename)" if @_ != 2; - chmod($_[0], $_[1]); + CORE::chmod($_[0], $_[1]); } sub fstat { usage "fstat(fd)" if @_ != 1; local *TMP; open(TMP, "<&$_[0]"); # Gross. - my @l = stat(TMP); + my @l = CORE::stat(TMP); close(TMP); @l; } sub mkdir { usage "mkdir(directoryname, mode)" if @_ != 2; - mkdir($_[0], $_[1]); + CORE::mkdir($_[0], $_[1]); } sub stat { usage "stat(filename)" if @_ != 1; - stat($_[0]); + CORE::stat($_[0]); } sub umask { usage "umask(mask)" if @_ != 1; - umask($_[0]); + CORE::umask($_[0]); } sub wait { usage "wait()" if @_ != 0; - wait(); + CORE::wait(); } sub waitpid { usage "waitpid(pid, options)" if @_ != 2; - waitpid($_[0], $_[1]); + CORE::waitpid($_[0], $_[1]); } sub gmtime { usage "gmtime(time)" if @_ != 1; - gmtime($_[0]); + CORE::gmtime($_[0]); } sub localtime { usage "localtime(time)" if @_ != 1; - localtime($_[0]); + CORE::localtime($_[0]); } sub time { usage "time()" if @_ != 0; - time; + CORE::time; } sub alarm { usage "alarm(seconds)" if @_ != 1; - alarm($_[0]); + CORE::alarm($_[0]); } sub chdir { usage "chdir(directory)" if @_ != 1; - chdir($_[0]); + CORE::chdir($_[0]); } sub chown { usage "chown(filename, uid, gid)" if @_ != 3; - chown($_[0], $_[1], $_[2]); + CORE::chown($_[0], $_[1], $_[2]); } sub execl { @@ -821,7 +821,7 @@ sub execvp { sub fork { usage "fork()" if @_ != 0; - fork; + CORE::fork; } sub getcwd @@ -861,12 +861,12 @@ sub getgroups { sub getlogin { usage "getlogin()" if @_ != 0; - getlogin(); + CORE::getlogin(); } sub getpgrp { usage "getpgrp()" if @_ != 0; - getpgrp($_[0]); + CORE::getpgrp; } sub getpid { @@ -876,7 +876,7 @@ sub getpid { sub getppid { usage "getppid()" if @_ != 0; - getppid; + CORE::getppid; } sub getuid { @@ -891,12 +891,16 @@ sub isatty { sub link { usage "link(oldfilename, newfilename)" if @_ != 2; - link($_[0], $_[1]); + CORE::link($_[0], $_[1]); } sub rmdir { usage "rmdir(directoryname)" if @_ != 1; - rmdir($_[0]); + CORE::rmdir($_[0]); +} + +sub setbuf { + redef "IO::Handle::setbuf()"; } sub setgid { @@ -909,18 +913,22 @@ sub setuid { $< = $_[0]; } +sub setvbuf { + redef "IO::Handle::setvbuf()"; +} + sub sleep { usage "sleep(seconds)" if @_ != 1; - sleep($_[0]); + CORE::sleep($_[0]); } sub unlink { usage "unlink(filename)" if @_ != 1; - unlink($_[0]); + CORE::unlink($_[0]); } sub utime { usage "utime(filename, atime, mtime)" if @_ != 3; - utime($_[1], $_[2], $_[0]); + CORE::utime($_[1], $_[2], $_[0]); } diff --git a/contrib/perl5/ext/POSIX/POSIX.pod b/contrib/perl5/ext/POSIX/POSIX.pod index 4726487..6a4a61a 100644 --- a/contrib/perl5/ext/POSIX/POSIX.pod +++ b/contrib/perl5/ext/POSIX/POSIX.pod @@ -1009,13 +1009,14 @@ Convert date and time information to string. Returns the string. Synopsis: - strftime(fmt, sec, min, hour, mday, mon, year, wday = 0, yday = 0, isdst = 0) + strftime(fmt, sec, min, hour, mday, mon, year, wday = -1, yday = -1, isdst = -1) The month (C<mon>), weekday (C<wday>), and yearday (C<yday>) begin at zero. I.e. January is 0, not 1; Sunday is 0, not 1; January 1st is 0, not 1. The -year (C<year>) is given in years since 1900. I.e. The year 1995 is 95; the +year (C<year>) is given in years since 1900. I.e., the year 1995 is 95; the year 2001 is 101. Consult your system's C<strftime()> manpage for details -about these and the other arguments. +about these and the other arguments. The given arguments are made consistent +by calling C<mktime()> before calling your system's C<strftime()> function. The string for Tuesday, December 12, 1995. diff --git a/contrib/perl5/ext/POSIX/POSIX.xs b/contrib/perl5/ext/POSIX/POSIX.xs index 6958c00..15e026e 100644 --- a/contrib/perl5/ext/POSIX/POSIX.xs +++ b/contrib/perl5/ext/POSIX/POSIX.xs @@ -10,8 +10,6 @@ # undef open # undef setmode # define open PerlLIO_open3 -# undef TAINT_PROPER -# define TAINT_PROPER(a) #endif #include <ctype.h> #ifdef I_DIRENT /* XXX maybe better to just rely on perl.h? */ @@ -2569,7 +2567,7 @@ new(packname = "POSIX::SigSet", ...) CODE: { int i; - RETVAL = (sigset_t*)safemalloc(sizeof(sigset_t)); + New(0, RETVAL, 1, sigset_t); sigemptyset(RETVAL); for (i = 1; i < items; i++) sigaddset(RETVAL, SvIV(ST(i))); @@ -2581,7 +2579,7 @@ void DESTROY(sigset) POSIX::SigSet sigset CODE: - safefree((char *)sigset); + Safefree(sigset); SysRet sigaddset(sigset, sig) @@ -2615,7 +2613,7 @@ new(packname = "POSIX::Termios", ...) CODE: { #ifdef I_TERMIOS - RETVAL = (struct termios*)safemalloc(sizeof(struct termios)); + New(0, RETVAL, 1, struct termios); #else not_here("termios"); RETVAL = 0; @@ -2629,7 +2627,7 @@ DESTROY(termios_ref) POSIX::Termios termios_ref CODE: #ifdef I_TERMIOS - safefree((char *)termios_ref); + Safefree(termios_ref); #else not_here("termios"); #endif @@ -3181,10 +3179,11 @@ sigaction(sig, action, oldaction = 0) sig_name[sig], strlen(sig_name[sig]), TRUE); + STRLEN n_a; /* Remember old handler name if desired. */ if (oldaction) { - char *hand = SvPVx(*sigsvp, PL_na); + char *hand = SvPVx(*sigsvp, n_a); svp = hv_fetch(oldaction, "HANDLER", 7, TRUE); sv_setpv(*svp, *hand ? hand : "DEFAULT"); } @@ -3195,7 +3194,7 @@ sigaction(sig, action, oldaction = 0) svp = hv_fetch(action, "HANDLER", 7, FALSE); if (!svp) croak("Can't supply an action without a HANDLER"); - sv_setpv(*sigsvp, SvPV(*svp, PL_na)); + sv_setpv(*sigsvp, SvPV(*svp, n_a)); mg_set(*sigsvp); /* handles DEFAULT and IGNORE */ act.sa_handler = sighandler; @@ -3234,7 +3233,7 @@ sigaction(sig, action, oldaction = 0) sigset = (sigset_t*) tmp; } else { - sigset = (sigset_t*)safemalloc(sizeof(sigset_t)); + New(0, sigset, 1, sigset_t); sv_setptrobj(*svp, sigset, "POSIX::SigSet"); } *sigset = oact.sa_mask; @@ -3256,7 +3255,20 @@ SysRet sigprocmask(how, sigset, oldsigset = 0) int how POSIX::SigSet sigset - POSIX::SigSet oldsigset + POSIX::SigSet oldsigset = NO_INIT +INIT: + if ( items < 3 ) { + oldsigset = 0; + } + else if (sv_derived_from(ST(2), "POSIX::SigSet")) { + IV tmp = SvIV((SV*)SvRV(ST(2))); + oldsigset = (POSIX__SigSet) tmp; + } + else { + New(0, oldsigset, 1, sigset_t); + sigemptyset(oldsigset); + sv_setref_pv(ST(2), "POSIX::SigSet", (void*)oldsigset); + } SysRet sigsuspend(signal_mask) @@ -3591,7 +3603,7 @@ mktime(sec, min, hour, mday, mon, year, wday = 0, yday = 0, isdst = 0) RETVAL char * -strftime(fmt, sec, min, hour, mday, mon, year, wday = 0, yday = 0, isdst = 0) +strftime(fmt, sec, min, hour, mday, mon, year, wday = -1, yday = -1, isdst = -1) char * fmt int sec int min @@ -3617,8 +3629,45 @@ strftime(fmt, sec, min, hour, mday, mon, year, wday = 0, yday = 0, isdst = 0) mytm.tm_wday = wday; mytm.tm_yday = yday; mytm.tm_isdst = isdst; + (void) mktime(&mytm); len = strftime(tmpbuf, sizeof tmpbuf, fmt, &mytm); - ST(0) = sv_2mortal(newSVpv(tmpbuf, len)); + /* + ** The following is needed to handle to the situation where + ** tmpbuf overflows. Basically we want to allocate a buffer + ** and try repeatedly. The reason why it is so complicated + ** is that getting a return value of 0 from strftime can indicate + ** one of the following: + ** 1. buffer overflowed, + ** 2. illegal conversion specifier, or + ** 3. the format string specifies nothing to be returned(not + ** an error). This could be because format is an empty string + ** or it specifies %p that yields an empty string in some locale. + ** If there is a better way to make it portable, go ahead by + ** all means. + */ + if ( ( len > 0 && len < sizeof(tmpbuf) ) + || ( len == 0 && strlen(fmt) == 0 ) ) { + ST(0) = sv_2mortal(newSVpv(tmpbuf, len)); + } else { + /* Possibly buf overflowed - try again with a bigger buf */ + int bufsize = strlen(fmt) + sizeof(tmpbuf); + char* buf; + int buflen; + + New(0, buf, bufsize, char); + while( buf ) { + buflen = strftime(buf, bufsize, fmt, &mytm); + if ( buflen > 0 && buflen < bufsize ) break; + bufsize *= 2; + Renew(buf, bufsize, char); + } + if ( buf ) { + ST(0) = sv_2mortal(newSVpv(buf, buflen)); + Safefree(buf); + } else { + ST(0) = sv_2mortal(newSVpv(tmpbuf, len)); + } + } } void diff --git a/contrib/perl5/ext/POSIX/hints/dynixptx.pl b/contrib/perl5/ext/POSIX/hints/dynixptx.pl new file mode 100644 index 0000000..9b63684 --- /dev/null +++ b/contrib/perl5/ext/POSIX/hints/dynixptx.pl @@ -0,0 +1,4 @@ +# Need to add an extra '-lc' to the end to work around a DYNIX/ptx bug +# PR#227670 - linker error on fpgetround() + +$self->{LIBS} = ['-ldb -lm -lc']; diff --git a/contrib/perl5/ext/POSIX/hints/mint.pl b/contrib/perl5/ext/POSIX/hints/mint.pl new file mode 100644 index 0000000..b975cbb --- /dev/null +++ b/contrib/perl5/ext/POSIX/hints/mint.pl @@ -0,0 +1,2 @@ +$self->{CCFLAGS} = $Config{ccflags} . ' -DNO_LOCALECONV_GROUPING -DNO_LOCALECONV_MON_GROUPING'; + |
