[PATCH: 5.005_03 && 5.005_57]4 ctl chars on EBCDIC not asciiish enough

[p5pRT]

Migrated from rt.perl.org#950 (status was 'resolved')

Searchable as RT950$

[p5pRT]

From pvhp@forte.com

$ 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​:

Inline Patch

```diff --- 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​:

Inline Patch

```diff 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 . + +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   .