Article 14652 of comp.lang.perl: Path: ig.co.uk!demon!uknet!EU.net!uunet!cs.utexas.edu!swrinde!ihnp4.ucsd.edu!munnari.oz.au!bunyip.cc.uq.oz.au!harbinger.cc.monash.edu.au!news.cs.su.oz.au!metro!ipso!gsms01.alcatel.oz.au!gsms01.alcatel.oz.au!not-for-mail From: jeremyp@gsms01.alcatel.oz.au (Peter Jeremy) Newsgroups: comp.lang.perl Subject: Bugs in perl, oraperl and a2p Date: 24 May 1994 16:03:16 +1000 Organization: Alcatel Australia Limited Lines: 243 Distribution: inet Message-ID: <2qn834$2fr@gsms01.alcatel.oz.au> NNTP-Posting-Host: gsms01.alcatel.oz.au Disclaimer: The views expressed herein are those of the author only In the process of converting a large awk script to perl, I have bumped into several misfeatures. I am using perl 4.034 and oraperl version 2 patchlevel 4 on SunOS 4.1.3. ---------------------------------------------------------------- 1) The perl problem is that setting $# to '%d' causes numeric output to be corrupted unless some non-numeric characters exist in the output, even if a different format is specified in a printf. gsms01% perl -ew '$# = "%d"; $a = 1; printf " %.0fx", $a; print "($a)\n";' 1x(1) gsms01% perl -ew '$# = "%d"; $a = 1; printf " %.0fx\n", $a; print "($a)\n";' 1x (1) gsms01% perl -ew '$# = "%d"; $a = 1; printf " %.0f\n", $a; print "($a)\n";' 1072693248(1) gsms01% perl -ew '$# = "%d"; $a = 1; printf " %d\n", $a; print "($a)\n";' 1072693248(1) gsms01% perl -ew '$# = "%.0f"; $a = 1; printf " %d\n", $a; print "($a)\n";' 1(1) gsms01% perl -ew '$a = 1; printf " %d\n", $a; print "($a)\n";' 1 (1) gsms01% Note that when $# is set to either '%d' or '%.0f', all whitespace is lost. With $# set to '%d', the value printed is 0x7ff00000, which is the high word of a double precision 1.0. ---------------------------------------------------------------- 2) The oraperl problem relates to LONG datatypes. oraperl internally uses shorts for the field lengths. From my reading of Oracle behaviour (and I don't have an up-to-date Pro*C manual handy to confirm), this should be an unsigned short (to allow up to 65535 bytes). This causes problems trying to read tables with LONG columns > 32K in length. I believe the following patch solves the problem, but I have not fully tested it yet. --- debug/orafns.c Wed Apr 27 15:00:44 1994 +++ orafns.c Tue May 10 15:54:39 1994 @@ -228,7 +228,7 @@ int i; struct cursor *csr; struct cursor *lda = (struct cursor *)strtoul(lda_s, (char **) NULL, 0); - short dsize; + word dsize; DBUG_ENTER("ora_open"); DBUG_PRINT("entry", ("ora_open(%s, \"%s\", %d)", lda_s, stmt, cache)); @@ -280,8 +280,8 @@ i = 0; do { - odsc(csr->csr, ++i, (short *) 0, (short *) 0, (short *) 0, - (short *) 0, (char *) 0, (short *) 0, (short *) 0); + odsc(csr->csr, ++i, (word *) 0, (word *) 0, (word *) 0, + (word *) 0, (char *) 0, (word *) 0, (word *) 0); } while (csr->csr->csrrc == 0); --i; ora_err.no = 0; @@ -317,7 +317,7 @@ i, i * sizeof(char *), (long) csr->data)); *csr->data = (char *) NULL; - if ((csr->len = (short *) malloc(i * sizeof(short))) == NULL) + if ((csr->len = (word *) malloc(i * sizeof(word))) == NULL) { DBUG_PRINT("malloc", ("insufficient memory for len")); oclose(csr->csr); @@ -327,9 +327,9 @@ DBUG_RETURN((char *) NULL); } DBUG_PRINT("malloc", ("got len array %d items %d bytes at %#lx", - i, i * sizeof(short), (long) csr->len)); + i, i * sizeof(word), (long) csr->len)); - if ((csr->rcode = (short **) malloc(i*sizeof(short *))) == NULL) + if ((csr->rcode = (word **) malloc(i*sizeof(word *))) == NULL) { DBUG_PRINT("malloc", ("insufficient memory for rcode")); oclose(csr->csr); @@ -340,9 +340,9 @@ } DBUG_PRINT("malloc", ("got rcode array %d items %d bytes at %#lx", - i, i * sizeof(short *), (long) csr->rcode)); + i, i * sizeof(word *), (long) csr->rcode)); - if ((csr->type = (short *) malloc(i * sizeof(short))) == NULL) + if ((csr->type = (word *) malloc(i * sizeof(word))) == NULL) { DBUG_PRINT("malloc", ("insufficient memory for type")); oclose(csr->csr); @@ -352,15 +352,15 @@ DBUG_RETURN((char *) NULL); } DBUG_PRINT("malloc",("got type array %d items %d bytes at %#lx", - i, i * sizeof(short), (long) csr->type)); + i, i * sizeof(word), (long) csr->type)); csr->nfields = i; for (i = 0 ; i < csr->nfields ; i++) { - odsc(csr->csr, i + 1, (short *) 0, (short *) 0, - (short *) 0, &csr->type[i], (char *) 0, - (short *) 0, &dsize); + odsc(csr->csr, i + 1, (word *) 0, (word *) 0, + (word *) 0, &csr->type[i], (char *) 0, + (word *) 0, &dsize); if ((csr->type[i] == 8) || (csr->type[i] == 24)) { @@ -386,7 +386,7 @@ i, (dsize + 1) * cache, csr->data[i])); if ((csr->rcode[i] = - (short *) malloc(sizeof(short) * cache)) == NULL) + (word *) malloc(sizeof(word) * cache)) == NULL) { DBUG_PRINT("malloc", ("insufficient memory for rcode[%d]", i)); @@ -397,10 +397,10 @@ DBUG_RETURN((char *) NULL); } DBUG_PRINT("malloc", ("got rcode %d, %d bytes at %#lx", - i, sizeof(short) * cache, csr->rcode[i])); + i, sizeof(word) * cache, csr->rcode[i])); odefin(csr->csr, i + 1, csr->data[i], dsize + 1, 5, 0, - (short *) 0, (char *) 0, 0, 0, (short *) 0, + (word *) 0, (char *) 0, 0, 0, (word *) 0, csr->rcode[i]); csr->len[i] = dsize; @@ -468,7 +468,7 @@ int truncate; { int i; - short len; + word len; struct cursor *csr = (struct cursor *)strtoul(csr_s, (char **) NULL, 0); static int n_titles = 0; @@ -533,7 +533,7 @@ for (i = 0 ; i < csr->nfields ; i++) { len = (truncate) ? csr->len[i] : 256; - oname(csr->csr, i + 1, (char *) -1, (short *) -1, + oname(csr->csr, i + 1, (char *) -1, (word *) -1, &titles[256 * i], &len); ora_result[i] = &titles[256 * i]; ora_result[i][len] = '\0'; @@ -559,7 +559,7 @@ char *csr_s; { int i; - short len; + word len; struct cursor *csr = (struct cursor *)strtoul(csr_s, (char **) NULL, 0); DBUG_ENTER("ora_lengths"); --- debug/orafns.h Wed Apr 27 15:00:44 1994 +++ orafns.h Tue May 10 15:54:36 1994 @@ -10,6 +10,8 @@ */ +typedef unsigned short word; + /* public functions to be called by Perl programs */ void ora_version(); @@ -77,7 +79,7 @@ struct csrdef *csr; char *hda, /* used if this cursor is an lda */ **data; /* used to receive database contents */ - short **rcode, /* used to receive fetch error codes */ + word **rcode, /* used to receive fetch error codes */ *type, /* used to receive data types */ *len; /* used to receive field lengths */ int cache_size, /* how many rows to cache */ ---------------------------------------------------------------- 3) a2p does not accept the following awk script: BEGIN { printf "hello\n" do { if ((getline) <= 0) exit; foo += $0 } while (1) } END { printf "%d", foo print "the end" } unless there is a semicolon following the `while (1)' (it says parse error in file /mnt/x1 at line 7 Translation aborted due to syntax errors. ). When the semicolon is added, the following script is produced, which includes a reference to an undefined label `line': #!/usr/local/bin/perl eval "exec /usr/local/bin/perl -S $0 $*" if $running_under_some_shell; # this emulates #! processing on NIH machines. # (remove #! line above if indigestible) eval '$'.$1.'$2;' while $ARGV[0] =~ /^([A-Za-z_]+=)(.*)/ && shift; # process any FOO=bar switches $, = ' '; # set output field separator $\ = "\n"; # set output record separator printf "hello\n"; do { if ((($_ = &Getline0(),$getline_ok)) <= 0) { last line; } $foo += $_; } while (1); while (<>) { } # (no line actions) printf '%d', $foo; print 'the end'; sub Getline0 { if ($getline_ok = (($_ = <>) ne '')) { chop; # strip record separator } $_; } -- Peter Jeremy (VK2PJ) peter@titan.alcatel.oz.au Alcatel Australia Limited jeremyp@gsms01.alcatel.oz.au 41 Mandible St Phone: +61 2 690 5019 ALEXANDRIA NSW 2015 Fax: +61 2 690 5247