From: Aristotle Pagaltzis Date: Wed, 31 Aug 2011 12:59:57 +0000 (+0200) Subject: In POSIX, drastically simplify the wrappers for "unimplemented" functions. X-Git-Tag: accepted/trunk/20130322.191538~2932^2~7 X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=8fe37eeda0ab69220877c0b1af801830a88f0944;p=platform%2Fupstream%2Fperl.git In POSIX, drastically simplify the wrappers for "unimplemented" functions. Replace all the subroutines that croak() with a data structure and 8 lines in POSIX::AUTOLOAD(). [By Aristotle Pagaltzis, with some editing by the committer, and most of his message changes applied as a previous commit to split apart improvements from pure refactoring] This commit eliminates the helper functions POSIX::refef() and POSIX::unimpl(), which were not part of the documented API, not exported, and not used in any code outside the core (that is visible to Google codesearch). --- diff --git a/ext/POSIX/lib/POSIX.pm b/ext/POSIX/lib/POSIX.pm index 05a474c..7899922 100644 --- a/ext/POSIX/lib/POSIX.pm +++ b/ext/POSIX/lib/POSIX.pm @@ -18,15 +18,18 @@ use Fcntl qw(FD_CLOEXEC F_DUPFD F_GETFD F_GETFL F_GETLK F_RDLCK F_SETFD S_IRGRP S_IROTH S_IRUSR S_IRWXG S_IRWXO S_IRWXU S_ISGID S_ISUID S_IWGRP S_IWOTH S_IWUSR S_IXGRP S_IXOTH S_IXUSR); -# Grandfather old foo_h form to new :foo_h form my $loaded; sub import { + my $pkg = shift; + load_imports() unless $loaded++; - my $this = shift; - my @list = map { m/^\w+_h$/ ? ":$_" : $_ } @_; + + # Grandfather old foo_h form to new :foo_h form + s/^(?=\w+_h$)/:/ for my @list = @_; + local $Exporter::ExportLevel = 1; - Exporter::import($this,@list); + Exporter::import($pkg,@list); } sub croak { require Carp; goto &Carp::croak } @@ -35,16 +38,109 @@ sub usage; XSLoader::load(); +my %replacement = ( + atexit => 'END {}', + atof => undef, + atoi => undef, + atol => undef, + bsearch => \'not supplied', + calloc => undef, + clearerr => 'IO::Handle::clearerr', + div => '/, % and int', + execl => undef, + execle => undef, + execlp => undef, + execv => undef, + execve => undef, + execvp => undef, + fclose => 'IO::Handle::close', + fdopen => 'IO::Handle::new_from_fd', + feof => 'IO::Handle::eof', + ferror => 'IO::Handle::error', + fflush => 'IO::Handle::flush', + fgetc => 'IO::Handle::getc', + fgetpos => 'IO::Seekable::getpos', + fgets => 'IO::Handle::gets', + fileno => 'IO::Handle::fileno', + fopen => 'IO::File::open', + fprintf => 'printf', + fputc => 'print', + fputs => 'print', + fread => 'read', + free => undef, + freopen => 'open', + fscanf => '<> and regular expressions', + fseek => 'IO::Seekable::seek', + fsetpos => 'IO::Seekable::setpos', + fsync => 'IO::Handle::sync', + ftell => 'IO::Seekable::tell', + fwrite => 'print', + labs => 'abs', + ldiv => '/, % and int', + longjmp => 'die', + malloc => undef, + memchr => 'index()', + memcmp => 'eq', + memcpy => '=', + memmove => '=', + memset => 'x', + offsetof => undef, + putc => 'print', + putchar => 'print', + puts => 'print', + qsort => 'sort', + rand => \'non-portable, use Perl\'s rand instead', + realloc => undef, + scanf => '<> and regular expressions', + setbuf => 'IO::Handle::setbuf', + setjmp => 'eval {}', + setvbuf => 'IO::Handle::setvbuf', + siglongjmp => 'die', + sigsetjmp => 'eval {}', + srand => \'not supplied, refer to Perl\'s srand documentation', + sscanf => 'regular expressions', + strcat => '.=', + strchr => 'index()', + strcmp => 'eq', + strcpy => '=', + strcspn => 'regular expressions', + strlen => 'length', + strncat => '.=', + strncmp => 'eq', + strncpy => '=', + strpbrk => undef, + strrchr => 'rindex()', + strspn => undef, + strtok => undef, + tmpfile => 'IO::File::new_tmpfile', + ungetc => 'IO::Handle::ungetc', + vfprintf => undef, + vprintf => undef, + vsprintf => undef, +); + +eval "sub $_;" for keys %replacement; + sub AUTOLOAD { no warnings 'uninitialized'; - if ($AUTOLOAD =~ /::(_?[a-z])/) { - # require AutoLoader; + + my ($func) = ($AUTOLOAD =~ /.*::(.*)/); + + if (exists $replacement{$func}) { + my $how = $replacement{$func}; + croak "Unimplemented: POSIX::$func() is C-specific, stopped" + unless defined $how; + croak "Unimplemented: POSIX::$func() is $$how" if ref $how; + croak "Use method $how() instead" if $how =~ /::/; + croak "Unimplemented: POSIX::$func() is C-specific, use $how instead"; + } + + if ($func =~ /^_?[a-z]/) { $AutoLoader::AUTOLOAD = $AUTOLOAD; goto &AutoLoader::AUTOLOAD } - my $constname = $AUTOLOAD; - $constname =~ s/.*:://; - constant($constname); + + constant($func); } package POSIX::SigAction; @@ -77,17 +173,6 @@ sub usage { croak "Usage: POSIX::$mess"; } -sub redef { - my ($mess) = @_; - croak "Use method $mess instead"; -} - -sub unimpl { - my ($mess) = @_; - $mess =~ s/xxx//; - croak "Unimplemented: POSIX::$mess"; -} - sub assert { usage "assert(expr)" if @_ != 1; if (!$_[0]) { @@ -203,22 +288,6 @@ sub getpwuid { CORE::getpwuid($_[0]); } -sub longjmp { - unimpl "longjmp() is C-specific, use die instead"; -} - -sub setjmp { - unimpl "setjmp() is C-specific, use eval {} instead"; -} - -sub siglongjmp { - unimpl "siglongjmp() is C-specific, use die instead"; -} - -sub sigsetjmp { - unimpl "sigsetjmp() is C-specific, use eval {} instead"; -} - sub kill { usage "kill(pid, sig)" if @_ != 2; CORE::kill $_[1], $_[0]; @@ -229,98 +298,6 @@ sub raise { CORE::kill $_[0], $$; # Is this good enough? } -sub offsetof { - unimpl "offsetof() is C-specific, stopped"; -} - -sub clearerr { - redef "IO::Handle::clearerr()"; -} - -sub fclose { - redef "IO::Handle::close()"; -} - -sub fdopen { - redef "IO::Handle::new_from_fd()"; -} - -sub feof { - redef "IO::Handle::eof()"; -} - -sub fgetc { - redef "IO::Handle::getc()"; -} - -sub fgets { - redef "IO::Handle::gets()"; -} - -sub fileno { - redef "IO::Handle::fileno()"; -} - -sub fopen { - redef "IO::File::open()"; -} - -sub fprintf { - unimpl "fprintf() is C-specific, use printf instead"; -} - -sub fputc { - unimpl "fputc() is C-specific, use print instead"; -} - -sub fputs { - unimpl "fputs() is C-specific, use print instead"; -} - -sub fread { - unimpl "fread() is C-specific, use read instead"; -} - -sub freopen { - unimpl "freopen() is C-specific, use open instead"; -} - -sub fscanf { - unimpl "fscanf() is C-specific, use <> and regular expressions instead"; -} - -sub fseek { - redef "IO::Seekable::seek()"; -} - -sub fsync { - redef "IO::Handle::sync()"; -} - -sub ferror { - redef "IO::Handle::error()"; -} - -sub fflush { - redef "IO::Handle::flush()"; -} - -sub fgetpos { - redef "IO::Seekable::getpos()"; -} - -sub fsetpos { - redef "IO::Seekable::setpos()"; -} - -sub ftell { - redef "IO::Seekable::tell()"; -} - -sub fwrite { - unimpl "fwrite() is C-specific, use print instead"; -} - sub getc { usage "getc(handle)" if @_ != 1; CORE::getc($_[0]); @@ -346,18 +323,6 @@ sub printf { CORE::printf STDOUT @_; } -sub putc { - unimpl "putc() is C-specific, use print instead"; -} - -sub putchar { - unimpl "putchar() is C-specific, use print instead"; -} - -sub puts { - unimpl "puts() is C-specific, use print instead"; -} - sub remove { usage "remove(filename)" if @_ != 1; (-d $_[0]) ? CORE::rmdir($_[0]) : CORE::unlink($_[0]); @@ -373,202 +338,42 @@ sub rewind { CORE::seek($_[0],0,0); } -sub scanf { - unimpl "scanf() is C-specific, use <> and regular expressions instead"; -} - sub sprintf { usage "sprintf(pattern, args...)" if @_ == 0; CORE::sprintf(shift,@_); } -sub sscanf { - unimpl "sscanf() is C-specific, use regular expressions instead"; -} - -sub tmpfile { - redef "IO::File::new_tmpfile()"; -} - -sub ungetc { - redef "IO::Handle::ungetc()"; -} - -sub vfprintf { - unimpl "vfprintf() is C-specific, stopped"; -} - -sub vprintf { - unimpl "vprintf() is C-specific, stopped"; -} - -sub vsprintf { - unimpl "vsprintf() is C-specific, stopped"; -} - sub abs { usage "abs(x)" if @_ != 1; CORE::abs($_[0]); } -sub atexit { - unimpl "atexit() is C-specific, use END {} instead"; -} - -sub atof { - unimpl "atof() is C-specific, stopped"; -} - -sub atoi { - unimpl "atoi() is C-specific, stopped"; -} - -sub atol { - unimpl "atol() is C-specific, stopped"; -} - -sub bsearch { - unimpl "bsearch() is not supplied"; -} - -sub calloc { - unimpl "calloc() is C-specific, stopped"; -} - -sub div { - unimpl "div() is C-specific, use /, % and int instead"; -} - sub exit { usage "exit(status)" if @_ != 1; CORE::exit($_[0]); } -sub free { - unimpl "free() is C-specific, stopped"; -} - sub getenv { usage "getenv(name)" if @_ != 1; $ENV{$_[0]}; } -sub labs { - unimpl "labs() is C-specific, use abs instead"; -} - -sub ldiv { - unimpl "ldiv() is C-specific, use /, % and int instead"; -} - -sub malloc { - unimpl "malloc() is C-specific, stopped"; -} - -sub qsort { - unimpl "qsort() is C-specific, use sort instead"; -} - -sub rand { - unimpl "rand() is non-portable, use Perl's rand instead"; -} - -sub realloc { - unimpl "realloc() is C-specific, stopped"; -} - -sub srand { - unimpl "srand() is not supplied, refer to Perl's srand documentation"; -} - sub system { usage "system(command)" if @_ != 1; CORE::system($_[0]); } -sub memchr { - unimpl "memchr() is C-specific, use index() instead"; -} - -sub memcmp { - unimpl "memcmp() is C-specific, use eq instead"; -} - -sub memcpy { - unimpl "memcpy() is C-specific, use = instead"; -} - -sub memmove { - unimpl "memmove() is C-specific, use = instead"; -} - -sub memset { - unimpl "memset() is C-specific, use x instead"; -} - -sub strcat { - unimpl "strcat() is C-specific, use .= instead"; -} - -sub strchr { - unimpl "strchr() is C-specific, use index() instead"; -} - -sub strcmp { - unimpl "strcmp() is C-specific, use eq instead"; -} - -sub strcpy { - unimpl "strcpy() is C-specific, use = instead"; -} - -sub strcspn { - unimpl "strcspn() is C-specific, use regular expressions instead"; -} - sub strerror { usage "strerror(errno)" if @_ != 1; local $! = $_[0]; $! . ""; } -sub strlen { - unimpl "strlen() is C-specific, use length instead"; -} - -sub strncat { - unimpl "strncat() is C-specific, use .= instead"; -} - -sub strncmp { - unimpl "strncmp() is C-specific, use eq instead"; -} - -sub strncpy { - unimpl "strncpy() is C-specific, use = instead"; -} - -sub strpbrk { - unimpl "strpbrk() is C-specific, stopped"; -} - -sub strrchr { - unimpl "strrchr() is C-specific, use rindex() instead"; -} - -sub strspn { - unimpl "strspn() is C-specific, stopped"; -} - sub strstr { usage "strstr(big, little)" if @_ != 2; CORE::index($_[0], $_[1]); } -sub strtok { - unimpl "strtok() is C-specific, stopped"; -} - sub chmod { usage "chmod(mode, filename)" if @_ != 2; CORE::chmod($_[0], $_[1]); @@ -638,30 +443,6 @@ sub chown { CORE::chown($_[0], $_[1], $_[2]); } -sub execl { - unimpl "execl() is C-specific, stopped"; -} - -sub execle { - unimpl "execle() is C-specific, stopped"; -} - -sub execlp { - unimpl "execlp() is C-specific, stopped"; -} - -sub execv { - unimpl "execv() is C-specific, stopped"; -} - -sub execve { - unimpl "execve() is C-specific, stopped"; -} - -sub execvp { - unimpl "execvp() is C-specific, stopped"; -} - sub fork { usage "fork()" if @_ != 0; CORE::fork; @@ -728,14 +509,6 @@ sub rmdir { CORE::rmdir($_[0]); } -sub setbuf { - redef "IO::Handle::setbuf()"; -} - -sub setvbuf { - redef "IO::Handle::setvbuf()"; -} - sub sleep { usage "sleep(seconds)" if @_ != 1; $_[0] - CORE::sleep($_[0]); @@ -899,7 +672,6 @@ our %EXPORT_TAGS = ( setsid setuid sysconf tcgetpgrp tcsetpgrp ttyname)], utime_h => [], - ); # Exporter::export_tags(); @@ -984,7 +756,6 @@ sub safe { $_[0]->{SAFE} = $_[1] if @_ > 1; $_[0]->{SAFE} }; package POSIX::SigRt; - sub _init { $_SIGRTMIN = &POSIX::SIGRTMIN; $_SIGRTMAX = &POSIX::SIGRTMAX; diff --git a/ext/POSIX/lib/POSIX.pod b/ext/POSIX/lib/POSIX.pod index 0327d05..c2ca1c9 100644 --- a/ext/POSIX/lib/POSIX.pod +++ b/ext/POSIX/lib/POSIX.pod @@ -39,13 +39,6 @@ and other miscellaneous objects. The remaining sections list various constants and macros in an organization which roughly follows IEEE Std 1003.1b-1993. -=head1 NOTE - -The POSIX module is probably the most complex Perl module supplied with -the standard distribution. It incorporates autoloading, namespace games, -and dynamic loading of code that's in Perl, C, or both. It's a great -source of wisdom. - =head1 CAVEATS A few functions are not implemented because they are C specific. If you