[PATCH] 5.004_58: the locale.t problem in IRIX
authorJarkko Hietaniemi <jhi@iki.fi>
Mon, 9 Feb 1998 19:47:22 +0000 (21:47 +0200)
committerMalcolm Beattie <mbeattie@sable.ox.ac.uk>
Thu, 12 Feb 1998 16:22:46 +0000 (16:22 +0000)
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: <netdb.h> API prototype probing
Date: Wed, 11 Feb 1998 12:50:35 +0200 (EET)

p4raw-id: //depot/perl@504

Configure
config_h.SH
pod/perldiag.pod
pp_sys.c
regcomp.c
t/op/misc.t
t/op/pat.t
t/op/re_tests
t/pragma/locale.t

index 952a685..df610b2 100755 (executable)
--- 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 <<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'
index 33009ab..5ff8844 100644 (file)
@@ -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
index 20c0ae1..6802b08 100644 (file)
@@ -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
index a5de48b..ce5af57 100644 (file)
--- 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
index aa713bc..a42c4db 100644 (file)
--- 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);
 }
-
-
-
index 7a7fc33..1ca45db 100755 (executable)
@@ -357,3 +357,4 @@ begin <a>
 init <b>
 end <c>
 argv <>
+########
index 5d8bf8a..5ea9bb4 100755 (executable)
@@ -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.]]/');
index b688a16..121e964 100644 (file)
@@ -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
index d068465..8875f7c 100755 (executable)
@@ -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;