[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[open-cobol-list] Bug report and a patch: moving numeric field to right
From: |
Ehud Karni |
Subject: |
[open-cobol-list] Bug report and a patch: moving numeric field to right justified alphnumeric |
Date: |
Thu, 2 Jul 2009 15:06:07 +0300 |
There is a bug in open-cobol-1.1 (2009-02-06).
When moving a numeric field to a right justified alphanumeric the JUST
clause is ignored.
e.g moving 0123 to 'X(06) just' gives "0123 " instead of " 0123".
Example program is listed after the patch that fixes the bug.
Ehud.
cd ~/open-cobol-1.1/libcob/
diff -c ~/open-cobol-1.1/libcob/move.c-sv ~/open-cobol-1.1/libcob/move.c
*** ~/open-cobol-1.1/libcob/move.c-sv Sat Jan 24 15:31:30 2009
--- ~/open-cobol-1.1/libcob/move.c Wed Jul 1 15:10:53 2009
***************
*** 306,326 ****
sign = cob_get_sign (f1);
data2 = f2->data;
size2 = f2->size;
! if (size1 >= size2) {
! memcpy (data2, data1, size2);
! } else {
diff = (int)(size2 - size1);
! zero_size = 0;
! /* move */
! memcpy (data2, data1, size1);
! /* implied 0 ('P's) */
! if (COB_FIELD_SCALE(f1) < 0) {
! zero_size = cob_min_int ((int)-COB_FIELD_SCALE(f1),
diff);
! memset (data2 + size1, '0', (size_t)zero_size);
! }
! /* padding */
! if (diff - zero_size > 0) {
! memset (data2 + size1 + zero_size, ' ', (size_t)(diff -
zero_size));
}
}
--- 306,349 ----
sign = cob_get_sign (f1);
data2 = f2->data;
size2 = f2->size;
! zero_size = (int)-COB_FIELD_SCALE(f1);
! zero_size = (zero_size > 0) ? zero_size : 0 ;
! /* the result depend on RIGHT JUSTIFICATION, scaling (of f1) and sizes
! NOT justified: result is : [real-data zeros spaces] truncated on right
! justified right result: [spaces real-data zeros] truncated on left
*/
! if (COB_FIELD_JUSTIFIED (f2)) {
! if (zero_size) {
! zero_size = cob_min_int (zero_size, size2) ;
! size2 -= zero_size ;
! memset (data2 + size2, '0', (size_t)zero_size);
! }
! if (size2) {
! diff = (int)(size2 - size1);
! if (diff > 0) {
! memset (data2, ' ', (size_t)diff);
! data2 += diff ;
! size2 -= diff ;
! }
! memcpy (data2, data1 + size1 - size2, size2);
! }
! }
! else {
diff = (int)(size2 - size1);
! if (diff < 0) {
! memcpy (data2, data1, size2);
! } else {
! /* move */
! memcpy (data2, data1, size1);
! /* implied 0 ('P's) */
! if (zero_size) {
! zero_size = cob_min_int (zero_size, diff);
! memset (data2 + size1, '0', (size_t)zero_size);
! diff -= zero_size;
! }
! /* padding */
! if (diff) {
! memset (data2 + size1 + zero_size, ' ',
(size_t)diff);
! }
}
}
Example program:
identification division.
program-id. test-just.
data division.
working-storage section.
01 chr0 pic x(04) value "char".
01 chr1.
03 num1 pic S9(04) value 11.
01 num2 pic S9(04) comp value 22.
01 num3 pic S9(04) comp-5 value 33.
01 num4 pic S9(04)PP value 4400.
01 num5 pic S9(04)PPPPP value 55500000.
01 nchr pic x(07).
01 jchr pic x(07) just right.
procedure division.
move chr0 to nchr, jchr.
display "move x to nrml, just: |" nchr "|, |" jchr "|".
move chr1 to nchr, jchr.
display "move g to nrml, just: |" nchr "|, |" jchr "|".
move num1 to nchr, jchr.
display "move 9 to nrml, just: |" nchr "|, |" jchr "|".
move num2 to nchr, jchr.
display "move b1 to nrml, just: |" nchr "|, |" jchr "|".
move num3 to nchr, jchr.
display "move b5 to nrml, just: |" nchr "|, |" jchr "|".
move num4 to nchr, jchr.
display "move P2 to nrml, just: |" nchr "|, |" jchr "|".
move num5 to nchr, jchr.
display "move P5 to nrml, just: |" nchr "|, |" jchr "|".
move 0 to return-code.
stop run.
--
Ehud Karni Tel: +972-3-7966-561 /"\
Mivtach - Simon Fax: +972-3-7976-561 \ / ASCII Ribbon Campaign
Insurance agencies (USA) voice mail and X Against HTML Mail
http://www.mvs.co.il FAX: 1-815-5509341 / \
GnuPG: 98EA398D <http://www.keyserver.net/> Better Safe Than Sorry
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [open-cobol-list] Bug report and a patch: moving numeric field to right justified alphnumeric,
Ehud Karni <=