bug-gnucobol
[Top][All Lists]
Advanced

[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


reply via email to

[Prev in Thread] Current Thread [Next in Thread]