Bug #950 for perl5: [PATCH: 5.005_03 && 5.005_57]4 ctl chars on EBCDIC not asciiish enough

$ perl -e 'print ord("\c?")' invalid control request: '\157' on ASCII: ord("\c?") == 127 $ perl -e 'print ord("\c@")' invalid control request: '\174' on ASCII: ord("\c@") == 0 $ perl -e 'print ord("\c^")' invalid control request: '\137' on ASCII: ord("\c^") == 30 $ perl -e 'print ord("\c_")' invalid control request: '\155' on ASCII: ord("\c_") == 31 everything else from "\cA" through "\c]" (ASCII order) works as "expected", that is on the EBCDIC machine "\cA" eq chr(0) etc. Here is a fix suitable for 5.005_03 and 5.005_57: --- ebcdic.c.orig Thu Jul 1 13:08:07 1999 +++ ebcdic.c Thu Jul 1 18:59:44 1999 @@ -24,6 +24,14 @@ } else { /* Want uncontrol */ if (ch == '\177' || ch == -1) return('?'); + else if (ch == '\157') + return('\177'); + else if (ch == '\174') + return('\000'); + else if (ch == '^') /* '\137' in 1047, '\260' in 819 */ + return('\036'); + else if (ch == '\155') + return('\037'); else if (0 < ch && ch < (sizeof(controllablechars) - 1)) return(controllablechars[ch+1]); else End of Patch. Here is a proposed new regression test that should flag any possible control character problems: diff -ruN perl5.005_57.orig/t/op/ctl_chrs.t perl5.005_57/t/op/ctl_chrs.t --- perl5.005_57.orig/t/op/ctl_chrs.t Wed Dec 31 16:00:00 1969 +++ perl5.005_57/t/op/ctl_chrs.t Thu Jul 1 19:27:46 1999 @@ -0,0 +1,77 @@ +#!./perl + +# $RCSfile: ctl_chrs.t,v $$Revision: 1.1 $$Date: 99/06/01 18:27:03 $ + +print "1..33\n"; + +# because of ebcdic.c these should be the same on asciiish +# and ebcdic machines. +# Peter Prymmer <pvhp@best.com>. + +my $c = "\c@"; +print +((ord($c) == 0) ? "" : "not "),"ok 1\n"; +$c = "\cA"; +print +((ord($c) == 1) ? "" : "not "),"ok 2\n"; +$c = "\cB"; +print +((ord($c) == 2) ? "" : "not "),"ok 3\n"; +$c = "\cC"; +print +((ord($c) == 3) ? "" : "not "),"ok 4\n"; +$c = "\cD"; +print +((ord($c) == 4) ? "" : "not "),"ok 5\n"; +$c = "\cE"; +print +((ord($c) == 5) ? "" : "not "),"ok 6\n"; +$c = "\cF"; +print +((ord($c) == 6) ? "" : "not "),"ok 7\n"; +$c = "\cG"; +print +((ord($c) == 7) ? "" : "not "),"ok 8\n"; +$c = "\cH"; +print +((ord($c) == 8) ? "" : "not "),"ok 9\n"; +$c = "\cI"; +print +((ord($c) == 9) ? "" : "not "),"ok 10\n"; +$c = "\cJ"; +print +((ord($c) == 10) ? "" : "not "),"ok 11\n"; +$c = "\cK"; +print +((ord($c) == 11) ? "" : "not "),"ok 12\n"; +$c = "\cL"; +print +((ord($c) == 12) ? "" : "not "),"ok 13\n"; +$c = "\cM"; +print +((ord($c) == 13) ? "" : "not "),"ok 14\n"; +$c = "\cN"; +print +((ord($c) == 14) ? "" : "not "),"ok 15\n"; +$c = "\cO"; +print +((ord($c) == 15) ? "" : "not "),"ok 16\n"; +$c = "\cP"; +print +((ord($c) == 16) ? "" : "not "),"ok 17\n"; +$c = "\cQ"; +print +((ord($c) == 17) ? "" : "not "),"ok 18\n"; +$c = "\cR"; +print +((ord($c) == 18) ? "" : "not "),"ok 19\n"; +$c = "\cS"; +print +((ord($c) == 19) ? "" : "not "),"ok 20\n"; +$c = "\cT"; +print +((ord($c) == 20) ? "" : "not "),"ok 21\n"; +$c = "\cU"; +print +((ord($c) == 21) ? "" : "not "),"ok 22\n"; +$c = "\cV"; +print +((ord($c) == 22) ? "" : "not "),"ok 23\n"; +$c = "\cW"; +print +((ord($c) == 23) ? "" : "not "),"ok 24\n"; +$c = "\cX"; +print +((ord($c) == 24) ? "" : "not "),"ok 25\n"; +$c = "\cY"; +print +((ord($c) == 25) ? "" : "not "),"ok 26\n"; +$c = "\cZ"; +print +((ord($c) == 26) ? "" : "not "),"ok 27\n"; +$c = "\c["; +print +((ord($c) == 27) ? "" : "not "),"ok 28\n"; +$c = "\c\\"; +print +((ord($c) == 28) ? "" : "not "),"ok 29\n"; +$c = "\c]"; +print +((ord($c) == 29) ? "" : "not "),"ok 30\n"; +$c = "\c^"; +print +((ord($c) == 30) ? "" : "not "),"ok 31\n"; +$c = "\c_"; +print +((ord($c) == 31) ? "" : "not "),"ok 32\n"; +$c = "\c?"; +print +((ord($c) == 127) ? "" : "not "),"ok 33\n"; + diff -ruN perl5.005_57.orig/MANIFEST perl5.005_57/MANIFEST --- perl5.005_57.orig/MANIFEST Tue May 25 02:26:20 1999 +++ perl5.005_57/MANIFEST Thu Jul 1 19:27:29 1999 @@ -1175,6 +1175,7 @@ t/op/cmp.t See if the various string and numeric compare work t/op/cond.t See if conditional expressions work t/op/context.t See if context propagation works +t/op/ctl_chrs.t See if "\c$letter" works t/op/defins.t See if auto-insert of defined() works t/op/delete.t See if delete works t/op/die.t See if die works End of Patch. With the former patch and a 5.005_03 version of the latter patch (available on request) I obtained these `make test` results: All tests successful. u=6.37 s=2.12 cu=100.82 cs=33.6 scripts=184 tests=6519 Peter Prymmer Summary of my perl5 (5.0 patchlevel 5 subversion 3) configuration: Platform: osname=os390, osvers=06.00, archname=os390 uname='os390 mvs3 06.00 02 9672 ' hint=recommended, useposix=true, d_sigaction=define usethreads=undef useperlio=undef d_sfio=undef Compiler: cc='c89', optimize=' ', gccversion= cppflags='' ccflags ='-DMAXSIG=38 -DOEMVS -D_OE_SOCKETS -D_XOPEN_SOURCE_EXTENDED -D_ALL_SOURCE -DYYDYNAMIC -I/usr/local/include' stdchar='char', d_stdstdio=undef, usevfork=false intsize=4, longsize=4, ptrsize=4, doublesize=8 d_longlong=undef, longlongsize=, d_longdbl=define, longdblsize=16 alignbytes=8, usemymalloc=n, prototype=define Linker and Libraries: ld='ld', ldflags =' -L/usr/local/lib' libpth=/usr/local/lib /lib /usr/lib libs=-lm -lc libc=, so=a, useshrplib=false, libperl=libperl.a Dynamic Linking: dlsrc=dl_none.xs, dlext=none, d_dlsymun=undef, ccdlflags='' cccdlflags='-W 0,dll,"langlvl(extended)"', lddlflags='' Characteristics of this binary (from libperl): Built under os390 Compiled at Jul 1 1999 18:59:55 @INC: lib /usr/local/lib/perl5/5.00503/os390 /usr/local/lib/perl5/5.00503 /usr/local/lib/perl5/site_perl/5.005/os390 /usr/local/lib/perl5/site_perl/5.005 .