From: Jarkko Hietaniemi Date: Mon, 9 Feb 1998 19:47:22 +0000 (+0200) Subject: [PATCH] 5.004_58: the locale.t problem in IRIX X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=4599a1dedd47b916c731b88cf14b8b7a145a28b0;p=p5sagit%2Fp5-mst-13.2.git [PATCH] 5.004_58: the locale.t problem in IRIX Date: Mon, 9 Feb 1998 19:47:22 +0200 (EET) Subject: [PATCH] 5.004_58: reserve the POSIX regexp extensions Date: Tue, 10 Feb 1998 15:12:12 +0200 (EET) Subject: [PATCH] 5.004_58: API prototype probing Date: Wed, 11 Feb 1998 12:50:35 +0200 (EET) p4raw-id: //depot/perl@504 --- diff --git a/Configure b/Configure index 952a685..df610b2 100755 --- a/Configure +++ b/Configure @@ -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 </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 <&4 <try.c < +#ifdef HAS_SOCKET +#include /* Might include */ +#endif +#ifdef I_NIIN +#include +#endif +#ifdef I_NETDB +#include +#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 <try.c <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 33009ab..5ff8844 100644 --- a/config_h.SH +++ b/config_h.SH @@ -329,35 +329,80 @@ sed <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 20c0ae1..6802b08 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 diff --git a/pp_sys.c b/pp_sys.c index a5de48b..ce5af57 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -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 diff --git a/regcomp.c b/regcomp.c index aa713bc..a42c4db 100644 --- a/regcomp.c +++ b/regcomp.c @@ -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 7a7fc33..1ca45db 100755 --- a/t/op/misc.t +++ b/t/op/misc.t @@ -357,3 +357,4 @@ begin init end argv <> +######## diff --git a/t/op/pat.t b/t/op/pat.t index 5d8bf8a..5ea9bb4 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 b688a16..121e964 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 d068465..8875f7c 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;