diff options
| -rwxr-xr-x | Configure | 232 | ||||
| -rw-r--r-- | config_h.SH | 67 | ||||
| -rw-r--r-- | pod/perldiag.pod | 24 | ||||
| -rw-r--r-- | pp_sys.c | 24 | ||||
| -rw-r--r-- | regcomp.c | 27 | ||||
| -rwxr-xr-x | t/op/misc.t | 1 | ||||
| -rwxr-xr-x | t/op/pat.t | 27 | ||||
| -rw-r--r-- | t/op/re_tests | 6 | ||||
| -rwxr-xr-x | t/pragma/locale.t | 10 |
9 files changed, 318 insertions, 100 deletions
@@ -317,13 +317,20 @@ d_Gconvert='' d_getgrps='' d_setgrps='' d_gethent='' -d_gethbadd='' -gethbadd_addr_type='' -gethbadd_alen_type='' -d_getnbadd='' -getnbadd_net_type='' +d_gethbyaddr='' +netdb_host_type='' +netdb_hlen_type='' +d_gethbyname='' +netdb_name_type='' +d_getnbyaddr='' +d_getnbyname='' +netdb_net_type='' aphostname='' d_gethname='' +d_getpbyname='' +d_getpbynumber='' +d_getsbyname='' +d_getsbyport='' d_phostname='' d_uname='' d_getlogin='' @@ -6624,7 +6631,11 @@ set fsetpos d_fsetpos eval $inlibc : see if gethostbyaddr exists -set gethostbyaddr d_gethbadd +set gethostbyaddr d_gethbyaddr +eval $inlibc + +: see if gethostbyname exists +set gethostbyname d_gethbyname eval $inlibc : see if gethostent exists @@ -6636,7 +6647,11 @@ set getlogin d_getlogin eval $inlibc : see if getnetbyaddr exists -set getnetbyaddr d_getnbadd +set getnetbyaddr d_getnbyaddr +eval $inlibc + +: see if getnetbyname exists +set getnetbyname d_getnbyname eval $inlibc : see if getpgid exists @@ -6655,6 +6670,22 @@ eval $inlibc set getpriority d_getprior eval $inlibc +: see if getprotobyname exists +set getprotobyname d_getpbyname +eval $inlibc + +: see if getprotobynumber exists +set getprotobynumber d_getpbynumber +eval $inlibc + +: see if getservbyname exists +set getservbyname d_getsbyname +eval $inlibc + +: see if getservbyport exists +set getservbyport d_getsbyport +eval $inlibc + : see if gettimeofday or ftime exists set gettimeofday d_gettimeod eval $inlibc @@ -9262,10 +9293,10 @@ eval $inhdr : check for type of arguments to gethostbyaddr. This will only really : work if the system supports prototypes and provides one for -: gethostbyaddr. -case "$d_gethbadd" in +: gethostbyaddr. The netdb_host_type and netdb_hlen_type get defined. +case "$d_gethbyaddr" in $define) - if test "X$gethbadd_addr_type" = X -o "X$gethbadd_alen_type" = X; then + if test "X$netdb_host_type" = X -o "X$netdb_hlen_type" = X; then $cat <<EOM Checking to see what type of arguments are expected by gethostbyaddr(). @@ -9292,72 +9323,130 @@ EOM #define Size_t $sizetype main() { - Gethbadd_addr_t addr; - Gethbadd_alen_t alen; + Netdb_alen_t alen = sizeof(struct in_addr); + Netdb_addr_t addr = (Netdb_addr_t)malloc(alen); struct hostent* hent; - extern struct hostent *gethostbyaddr(const Gethbadd_addr_t, Gethbadd_alen_t, int); + extern struct hostent *gethostbyaddr(Netdb_addr_t, Netdb_alen_t, int); - alen = sizeof(struct in_addr); - addr = (Gethbadd_addr_t)malloc(alen); - /* We do not execute this so the contents of the addr matter not. */ + /* We do not execute this so the arguments matter not. */ hent = gethostbyaddr(addr, alen, AF_INET); exit(0); } EOCP - for xxx in "void *" "char *"; do - for yyy in Size_t int; do - if $cc $ccflags -c -DGethbadd_addr_t="$xxx" -DGethbadd_alen_t="$yyy" try.c >/dev/null 2>&1 ; then - gethbadd_addr_type="$xxx" - gethbadd_alen_type="$yyy" + for xxx in in_addr_t "const void *" "const char *" "void *" "char *"; do + for yyy in Size_t long int; do + if $cc $ccflags -c -DNetdb_addr_t="$xxx" -DNetdb_alen_t="$yyy" try.c >/dev/null 2>&1 ; then + netdb_host_type="$xxx" + netdb_hlen_type="$yyy" $cat >&4 <<EOM -Your system uses $xxx for the 1st argument to gethostbyaddr. -and the 2nd argument to gethostbyaddr is $yyy. +Your system accepts $xxx for the 1st argument to gethostbyaddr. +and the 2nd argument to gethostbyaddr can be $yyy. EOM break fi done - test "X$gethbadd_addr_type" != X && break + test "X$netdb_host_type" != X && break done - if test "X$gethbadd_addr_type" = X; then + if test "X$netdb_host_type" = X; then rp='What is the type for the 1st argument to gethostbyaddr?' dflt="void *" . ./myread - gethbadd_addr_type="$ans" + netdb_host_type="$ans" # Remove the "const" if needed. - gethbadd_addr_type=`echo "$gethbadd_addr_type" | sed 's/^const //'` + netdb_host_type=`echo "$netdb_host_type" | sed 's/^const //'` rp='What is the type for the 2nd argument to gethostbyaddr ?' dflt="Size_t" . ./myread - gethbadd_alen_type="$ans" + netdb_hlen_type="$ans" fi $rm -f try.[co] else $cat >&4 <<EOM -Your system uses $gethbadd_addr_type for the 1st argument to gethostbyaddr. -and the 2nd argument to gethostbyaddr is $gethbadd_alen_type. +Your system accepts $netdb_host_type for the 1st argument to gethostbyaddr. +and the 2nd argument to gethostbyaddr can be $netdb_hlen_type. EOM fi ;; -*) gethbadd_addr_type='void *' - gethbadd_alen_type='Size_t' +*) netdb_host_type='void *' + netdb_hlen_type='Size_t' ;; esac +: check for type of arguments to gethostbyname. This will only really +: work if the system supports prototypes and provides one for +: gethostbyname. The netdb_name_type gets defined. +case "$d_gethbyname" in +$define) + if test "X$netdb_name_type" = X; then + $cat <<EOM + +Checking to see what type of arguments are expected by gethostbyname(). +EOM + $cat >try.c <<EOCP +#$i_niin I_NIIN +#$i_netdb I_NETDB +#$d_socket HAS_SOCKET +#$d_socket HAS_SOCKET +#include <sys/types.h> +#ifdef HAS_SOCKET +#include <sys/socket.h> /* Might include <sys/bsdtypes.h> */ +#endif +#ifdef I_NIIN +#include <netinet/in.h> +#endif +#ifdef I_NETDB +#include <netdb.h> +#endif +main() +{ + char* host = "localhost"; + struct hostent* hent; + + extern struct hostent *gethostbyname(Netdb_name_t); + + /* We do not execute this so the arguments matter not. */ + hent = gethostbyname(host); + + exit(0); +} +EOCP + for xxx in "const char *" "char *"; do + if $cc $ccflags -c -DNetdb_name_t="$xxx" try.c >/dev/null 2>&1 ; then + netdb_name_type="$xxx" + echo "Your system accepts $xxx for the 1st argument to gethostbyname." >&4 + break + fi + done + if test "X$netdb_name_type" = X; then + rp='What is the type for the 1st argument to gethostbyname?' + dflt="char *" + . ./myread + netdb_name_type="$ans" + fi + $rm -f try.[co] + else + echo "Your system accepts $netdb_name_type for the 1st argument to gethostbyname." >&4 + fi + ;; +*) netdb_name_type='char *' + ;; +esac + : check for type of arguments to getnetbyaddr. This will only really : work if the system supports prototypes and provides one for -: getnetbyaddr. -case "$d_getnbadd" in +: getnetbyaddr. The netdb_net_type gets defined. +case "$d_getnbyaddr" in $define) - if test "X$getnbadd_net_type" = X; then - $cat <<EOM + if test "X$netdb_net_type" = X; then + $cat <<EOM Checking to see what type of arguments are expected by getnetbyaddr(). EOM - $cat >try.c <<EOCP + $cat >try.c <<EOCP #$i_niin I_NIIN #$i_netdb I_NETDB #$d_socket HAS_SOCKET @@ -9374,37 +9463,37 @@ EOM #endif main() { - Getnbadd_net_t net; - struct netent* nent; + Netdb_net_t net; + struct netent* nent; - extern struct netent *getnetbyaddr(Getnbadd_net_t, int); + extern struct netent *getnetbyaddr(Netdb_net_t, int); - /* We do not execute this so the contents of the net matter not. */ - nent = getnetbyaddr(net, AF_INET); + /* We do not execute this so the arguments matter not. */ + nent = getnetbyaddr(net, 2); - exit(0); + exit(0); } EOCP - for xxx in in_addr_t long int; do - if $cc $ccflags -c -DGetnbadd_net_t="$xxx" try.c >/dev/null 2>&1 ; then - getnbadd_net_type="$xxx" - echo "Your system uses $xxx for the 1st argument to getnetbyaddr." >&4 - break - fi - done - if test "X$getnbadd_net_type" = X; then - rp='What is the type for the 1st argument to getnetbyaddr?' - dflt="long" - . ./myread - getnbadd_net_type="$ans" - fi - $rm -f try.[co] - else - echo "Your system uses $getnbadd_net_type for the 1st argument to getnetbyaddr." >&4 - fi - ;; -*) getnbadd_net_type='long' - ;; + for xxx in in_addr_t "unsigned long" long "unsigned int" int; do + if $cc $ccflags -c -DNetdb_net_t="$xxx" try.c >/dev/null 2>&1 ; then + netdb_net_type="$xxx" + echo "Your system accepts $xxx for the 1st argument to getnetbyaddr." >&4 + break + fi + done + if test "X$netdb_net_type" = X; then + rp='What is the type for the 1st argument to getnetbyaddr?' + dflt="long" + . ./myread + netdb_net_type="$ans" + fi + $rm -f try.[co] + else + echo "Your system accepts $netdb_net_type for the 1st argument to getnetbyaddr." >&4 + fi + ;; +*) netdb_net_type='long' + ;; esac : see what type of char stdio uses. @@ -10356,19 +10445,26 @@ d_fsetpos='$d_fsetpos' d_ftime='$d_ftime' d_getgrps='$d_getgrps' d_setgrps='$d_setgrps' -d_gethbadd='$d_gethbadd' -gethbadd_addr_type='$gethbadd_addr_type' -gethbadd_alen_type='$gethbadd_alen_type' +d_gethbyaddr='$d_gethbyaddr' +netdb_host_type='$netdb_host_type' +netdb_hlen_type='$netdb_hlen_type' +d_gethbynam='$d_gethbynam' +netdb_name_type='$netdb_name_type' d_gethent='$d_gethent' d_gethname='$d_gethname' d_getlogin='$d_getlogin' -d_getnbadd='$d_getnbadd' -getnbadd_net_type='$getnbadd_net_type' +d_getnbyaddr='$d_getnbyaddr' +d_getnbyname='$d_getnbyname' +netdb_net_type='$netdb_net_type' d_getpgid='$d_getpgid' d_getpgrp2='$d_getpgrp2' d_getpgrp='$d_getpgrp' d_getppid='$d_getppid' d_getprior='$d_getprior' +d_getpbyname='$d_getpbyname' +d_getpbynumber='$d_getpbynumber' +d_getsbyname='$d_getsbyname' +d_getsbyport='$d_getsbyport' d_gettimeod='$d_gettimeod' d_gnulibc='$d_gnulibc' d_htonl='$d_htonl' diff --git a/config_h.SH b/config_h.SH index 33009ab3c2..5ff88445ac 100644 --- a/config_h.SH +++ b/config_h.SH @@ -329,35 +329,80 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #$d_gethent HAS_GETHOSTENT /**/ -/* HAS_GETHBADD: +/* HAS_GETHOSTBYADDR: * This symbol, if defined, indicates that the gethostbyaddr routine is - * available to lookup host names by their IP addresses. + * available to lookup hosts by their IP addresses. */ -#$d_gethbadd HAS_GETHBADD /**/ +#$d_gethbyaddr HAS_GETHOSTBYADDR /**/ -/* Gethbadd_addr_t: +/* Netdb_host_t: * This symbol holds the type used for the 1st argument * to gethostbyaddr(). */ -#define Gethbadd_addr_t $gethbadd_addr_type +#define Netdb_host_t $netdb_host_type -/* Gethbadd_alen_t: +/* Netdb_hlen_t: * This symbol holds the type used for the 2nd argument * to gethostbyaddr(). */ -#define Gethbadd_alen_t $gethbadd_alen_type +#define Netdb_hlen_t $netdb_hlen_type -/* HAS_GETNBADD: +/* HAS_GETHOSTBYNAME: + * This symbol, if defined, indicates that the gethostbyname routine is + * available to lookup hosts by their DNS names. + */ +#$d_gethbyname HAS_GETHOSTBYNAME /**/ + +/* Netdb_name_t: + * This symbol holds the type used for the 1st argument + * to gethostbyname(), the 1st argument to getnetbyname(), + * the 1st argument to getprotobyname(), the 1st argument to + * getservbyname(), the 2nd argument to getservbyname(), + * and the 2nd argument to getservbyport(). + */ +#define Netdb_name_t $netdb_name_type + +/* HAS_GETNETBYADD: * This symbol, if defined, indicates that the getnetbyaddr routine is * available to lookup networks by their IP addresses. */ -#$d_getnbadd HAS_GETNBADD /**/ +#$d_getnbyaddr HAS_GETNETBYADD /**/ -/* Gethbadd_net_t: +/* Netdb_net_t: * This symbol holds the type used for the 1st argument * to getnetbyaddr(). */ -#define Getnbadd_net_t $getnbadd_net_type +#define Netdb_net_t $netdb_net_type + +/* HAS_GETNETBYNAME: + * This symbol, if defined, indicates that the getnetbyname routine is + * available to lookup networks by their names. + */ +#$d_getnbyname HAS_GETNETBYNAME /**/ + +/* HAS_GETPROTOBYNAME: + * This symbol, if defined, indicates that the getprotobyname routine is + * available to lookup protocols by their names. + */ +#$d_getpbyname HAS_GETPROTOBYNAME /**/ + +/* HAS_GETPROTOBYNUMBER: + * This symbol, if defined, indicates that the getprotobynumber routine is + * available to lookup protocols by their numbers. + */ +#$d_getpbynumber HAS_GETPROTOBYNUMBER /**/ + +/* HAS_GETSERVBYNAME: + * This symbol, if defined, indicates that the getservbyname routine is + * available to lookup services by their names. + */ +#$d_getsbyname HAS_GETSERVBYNAME /**/ + +/* HAS_GETSERVBYPORT: + * This symbol, if defined, indicates that the getservbyport routine is + * available to lookup services by their ports. + */ +#$d_getsbyport HAS_GETSERVBYPORT /**/ /* HAS_UNAME: * This symbol, if defined, indicates that the C program may use the diff --git a/pod/perldiag.pod b/pod/perldiag.pod index 20c0ae1325..6802b08ac5 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -899,6 +899,30 @@ a B<-e> switch. Maybe your /tmp partition is full, or clobbered. opposed to a subroutine reference): no such method callable via the package. If method name is C<???>, this is an internal error. +=item Character class syntax [. .] is reserved for future extensions + +(W) Within regular expression character classes ([]) the syntax beginning +with "[." and ending with ".]" is reserved for future extensions. +If you need to represent those character sequences inside a regular +expression character class, just quote the square brackets with the +backslash: "\[." and ".\]". + +=item Character class syntax [: :] is reserved for future extensions + +(W) Within regular expression character classes ([]) the syntax beginning +with "[:" and ending with ":]" is reserved for future extensions. +If you need to represent those character sequences inside a regular +expression character class, just quote the square brackets with the +backslash: "\[:" and ":\]". + +=item Character class syntax [= =] is reserved for future extensions + +(W) Within regular expression character classes ([]) the syntax +beginning with "[=" and ending with "=]" is reserved for future extensions. +If you need to represent those character sequences inside a regular +expression character class, just quote the square brackets with the +backslash: "\[=" and "=\]". + =item chmod: mode argument is missing initial 0 (W) A novice will sometimes say @@ -3579,8 +3579,8 @@ PP(pp_ghostent) register char **elem; register SV *sv; #if defined(HAS_GETHOSTENT) && !defined(DONT_DECLARE_STD) - struct hostent *PerlSock_gethostbyname(const char *); - struct hostent *PerlSock_gethostbyaddr(const Gethbadd_addr_t, Gethbadd_alen_t, int); + struct hostent *PerlSock_gethostbyaddr(Netdb_host_t, Netdb_hlen_t, int); + struct hostent *PerlSock_gethostbyname(Netdb_name_t); #ifndef PerlSock_gethostent struct hostent *PerlSock_gethostent(void); #endif @@ -3596,9 +3596,9 @@ PP(pp_ghostent) int addrtype = POPi; SV *addrsv = POPs; STRLEN addrlen; - Gethbadd_addr_t addr = (Gethbadd_addr_t) SvPV(addrsv, addrlen); + Netdb_host_t addr = (Netdb_host_t) SvPV(addrsv, addrlen); - hent = PerlSock_gethostbyaddr(addr, (Gethbadd_alen_t) addrlen, addrtype); + hent = PerlSock_gethostbyaddr(addr, (Netdb_hlen_t) addrlen, addrtype); } else #ifdef HAS_GETHOSTENT @@ -3682,12 +3682,8 @@ PP(pp_gnetent) register char **elem; register SV *sv; #ifdef NETDB_H_OMITS_GETNET - struct netent *getnetbyname(const char *); - /* - * long is wrong for getnetbyadddr (e.g. on Alpha). POSIX.1g says - * in_addr_t but then such systems don't have broken netdb.h anyway. - */ - struct netent *getnetbyaddr(Getnbadd_net_t, int); + struct netent *getnetbyaddr(Netdb_net_t, int); + struct netent *getnetbyname(Netdb_name_t); struct netent *getnetent(void); #endif struct netent *nent; @@ -3696,7 +3692,7 @@ PP(pp_gnetent) nent = getnetbyname(POPp); else if (which == OP_GNBYADDR) { int addrtype = POPi; - Getnbadd_net_t addr = (Getnbadd_net_t) U_L(POPn); + Netdb_net_t addr = (Netdb_net_t) U_L(POPn); nent = getnetbyaddr(addr, addrtype); } else @@ -3761,7 +3757,7 @@ PP(pp_gprotoent) register char **elem; register SV *sv; #ifndef DONT_DECLARE_STD - struct protoent *PerlSock_getprotobyname(const char *); + struct protoent *PerlSock_getprotobyname(Netdb_name_t); struct protoent *PerlSock_getprotobynumber(int); #ifndef PerlSock_getprotoent struct protoent *PerlSock_getprotoent(void); @@ -3833,8 +3829,8 @@ PP(pp_gservent) register char **elem; register SV *sv; #ifndef DONT_DECLARE_STD - struct servent *PerlSock_getservbyname(const char *, const char *); - struct servent *PerlSock_getservbynumber(); + struct servent *PerlSock_getservbyname(Netdb_name_t, Netdb_name_t); + struct servent *PerlSock_getservbyport(int, Netdb_name_t); #ifndef PerlSock_getservent struct servent *PerlSock_getservent(void); #endif @@ -1866,6 +1866,30 @@ regclass(void) while (regparse < regxend && *regparse != ']') { skipcond: Class = UCHARAT(regparse++); + if (Class == '[' && regparse + 1 < regxend && + /* I smell either [: or [= or [. -- POSIX has been here, right? */ + (*regparse == ':' || *regparse == '=' || *regparse == '.')) { + char posixccc = *regparse; + char* posixccs = regparse++; + + while (regparse < regxend && *regparse != posixccc) + regparse++; + if (regparse == regxend) + /* Grandfather lone [:, [=, [. */ + regparse = posixccs; + else { + regparse++; /* skip over the posixccc */ + if (*regparse == ']') { + /* Not Implemented Yet. + * (POSIX Extended Character Classes, that is) + * The text between e.g. [: and :] would start + * at posixccs + 1 and stop at regparse - 2. */ + if (dowarn && !SIZE_ONLY) + warn("Character class syntax [%c %c] is reserved for future extensions", posixccc, posixccc); + regparse++; /* skip over the ending ] */ + } + } + } if (Class == '\\') { Class = UCHARAT(regparse++); switch (Class) { @@ -2662,6 +2686,3 @@ re_croak2(const char* pat1,const char* pat2, va_alist) buf[l1] = '\0'; /* Overwrite \n */ croak("%s", buf); } - - - diff --git a/t/op/misc.t b/t/op/misc.t index 7a7fc334d3..1ca45db039 100755 --- a/t/op/misc.t +++ b/t/op/misc.t @@ -357,3 +357,4 @@ begin <a> init <b> end <c> argv <> +######## diff --git a/t/op/pat.t b/t/op/pat.t index 5d8bf8ad78..5ea9bb44ae 100755 --- a/t/op/pat.t +++ b/t/op/pat.t @@ -2,7 +2,7 @@ # $RCSfile: pat.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:12 $ -print "1..101\n"; +print "1..104\n"; $x = "abc\ndef\n"; @@ -354,3 +354,28 @@ $x =~ /.a/g; print "not " unless f(pos($x)) == 4; print "ok $test\n"; $test++; + +sub must_warn_pat { + my $warn_pat = shift; + return sub { print "not " unless $_[0] =~ /$warn_pat/ } +} + +sub must_warn { + my ($warn_pat, $code) = @_; + local $^W; local %SIG; + eval 'BEGIN { $^W = 1; $SIG{__WARN__} = $warn_pat };' . $code; + print "ok $test\n"; + $test++; +} + + +sub make_must_warn { + my $warn_pat = shift; + return sub { must_warn(must_warn_pat($warn_pat)) } +} + +my $for_future = make_must_warn('reserved for future extensions'); + +&$for_future('q(a:[b]:) =~ /[x[:foo:]]/'); +&$for_future('q(a=[b]=) =~ /[x[=foo=]]/'); +&$for_future('q(a.[b].) =~ /[x[.foo.]]/'); diff --git a/t/op/re_tests b/t/op/re_tests index b688a167f2..121e96481f 100644 --- a/t/op/re_tests +++ b/t/op/re_tests @@ -431,6 +431,12 @@ $(?<=^(a)) a y $1 a (?{$a=2})(a(?{local$a=$a+1}))*aak*c(?{$b=$a}) yaaxxaaaacd y $b 4 (>a+)ab aaab n - - (?>a+)b aaab y - - +([[:]+) a:[b]: y $1 :[ +([[=]+) a=[b]= y $1 =[ +([[.]+) a.[b]. y $1 .[ +[a[:xyz: - c - /[a[:xyz:/: unmatched [] in regexp +[a[:xyz:] - c - /[a[:xyz:]/: unmatched [] in regexp +([a[:xyz:]b]+) pbaq y $1 ba ((?>a+)b) aaab y $1 aaab (?>(a+))b aaab y $1 aaa ((?>[^()]+)|\([^()]*\))+ ((abc(ade)ufh()()x y $& abc(ade)ufh()()x diff --git a/t/pragma/locale.t b/t/pragma/locale.t index d068465fb3..8875f7caa6 100755 --- a/t/pragma/locale.t +++ b/t/pragma/locale.t @@ -291,14 +291,18 @@ locatelocale(\$Spanish, \@Spanish, ($Locale, @Locale) = ($Spanish, @Spanish) if (@Spanish > @Locale); -print "# Locale = $Locale\n"; -print "# Alnum_ = @Locale\n"; - { local $^W = 0; setlocale(&LC_ALL, $Locale); } +# Sort it now that LC_ALL has been set. + +@Locale = sort @Locale; + +print "# Locale = $Locale\n"; +print "# Alnum_ = @Locale\n"; + { my $i = 0; |