Integrate with perlio.

p4raw-id: //depot/perl@13798

diff --git a/hints/unicos.sh b/hints/unicos.sh
index 026259f..e25b3fd 100644 (file)
--- a/hints/unicos.sh
+++ b/hints/unicos.sh
@@ -15,7 +15,7 @@ ccflags="$ccflags -h rounddiv"
 # isn't correctly saved and restored --Mark P. Lutz 
 pp_ctl_cflags='ccflags="$ccflags -h scalar0 -h vector0"'
 # Otherwise the unpack %65c checksums will fail.
-pp_pack_cflags='ccflags="$ccflags -h scalar0 -h vector0"'
+pp_pack_cflags='optimize="$ccflags -h scalar0 -h vector0"'
 case "$usemymalloc" in
 '') # The perl malloc.c SHOULD work says Ilya.
     # But for the time being (5.004_68), alas, it doesn't. --jhi

diff --git a/hints/unicosmk.sh b/hints/unicosmk.sh
index 5fd5342..93ed9a6 100644 (file)
--- a/hints/unicosmk.sh
+++ b/hints/unicosmk.sh
@@ -29,4 +29,4 @@ if test "$d_shm" = ""; then
     esac
 fi
 # Otherwise the unpack %65c checksums will fail.
-pp_pack_cflags='ccflags="$ccflags -h scalar0 -h vector0"'
+pp_pack_cflags='optimize="-h scalar0 -h vector0"'

diff --git a/lib/charnames.pm b/lib/charnames.pm
index ec200ec..1297a76 100644 (file)
--- a/lib/charnames.pm
+++ b/lib/charnames.pm
@@ -55,7 +55,10 @@ sub charnames
   }
 
   ## If we don't have it by now, give up.
-  die "Unknown charname '$name'" unless @off;
+  unless (@off) {
+      carp "Unknown charname '$name'";
+      return "\x{FFFD}";
+  }
 
   ##
   ## Now know where in the string the name starts.
@@ -78,10 +81,11 @@ sub charnames
   if ($^H & $bytes::hint_bits) {       # "use bytes" in effect?
     use bytes;
     return chr $ord if $ord <= 255;
-    my $hex = sprintf '%X=0%o', $ord, $ord;
+    my $hex = sprintf "%04x", $ord;
     my $fname = substr $txt, $off[0] + 2, $off[1] - $off[0] - 2;
-    die "Character 0x$hex with name '$fname' is above 0xFF";
+    croak "Character 0x$hex with name '$fname' is above 0xFF";
   }
+
   return pack "U", $ord;
 }
 
@@ -123,6 +127,8 @@ sub import
   }
 }
 
+require Unicode::UCD; # for Unicode::UCD::_getcode()
+
 my %viacode;
 
 sub viacode
@@ -131,16 +137,24 @@ sub viacode
         carp "charnames::viacode() expects one numeric argument";
         return ()
     }
+
     my $arg = shift;
+    my $code = Unicode::UCD::_getcode($arg);
 
     my $hex;
-    if ($arg =~ m/^[0-9]+$/) {
+
+    if (defined $code) {
         $hex = sprintf "%04X", $arg;
     } else {
         carp("unexpected arg \"$arg\" to charnames::viacode()");
         return;
     }
 
+    if ($code > 0x10FFFF) {
+       carp "Unicode characters only allocated up to 0x10FFFF (you asked for $hex)";
+       return "\x{FFFD}";
+    }
+
     return $viacode{$hex} if exists $viacode{$hex};
 
     $txt = do "unicore/Name.pl" unless $txt;
@@ -282,6 +296,11 @@ Returns undef if no name is known for the name.
 This works only for the standard names, and does not yet aply 
 to custom translators.
 
+=head1 ILLEGAL CHARACTERS
+
+If you ask for a character that does not exist, a warning is given
+and the special Unicode I<replacement character> "\x{FFFD}" is returned.
+
 =head1 BUGS
 
 Since evaluation of the translation function happens in a middle of

diff --git a/perl.h b/perl.h
index 47ebb09..d25ffd7 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -425,7 +425,7 @@ int usleep(unsigned int);
 #  define MYSWAP
 #endif
 
-/* Cannot include embed.h here on Win32 as win32.h has not
+/* Cannot include embed.h here on Win32 as win32.h has not 
    yet been included and defines some config variables e.g. HAVE_INTERP_INTERN
  */
 #if !defined(PERL_FOR_X2P) && !(defined(WIN32)||defined(VMS))

diff --git a/t/op/utf8decode.t b/t/op/utf8decode.t
old mode 100755 (executable)
new mode 100644 (file)