[open-cobol-list] Bug report and a patch: length of redefine/renames is 0.

[Ehud Karni]

There is a bug in open-cobol-1.1 (2009-02-06).

Use of:  01 <name> constant length of <redefine/renames-field>.
set the constant to 0, ignoring the real size.

Use of: move length of <redefine/renames-field> to <dest>.
works OK.

An example program (with both redefine and renames):

       identification division.
       program-id. tst-init.
       environment     division.
       input-output    section.
       file-control.
       data division.
       working-storage section.
           01  wrk-rec.
               03  wrk-dx2.
                   05  dx2-ovdsnt          pic -(07)9.
                   05  filler              pic x(10).
                   05  dx2-sum             pic -(07)9.
                   05  filler              pic x(10).
                   05  dx2-yg              pic x(05).
               03  rdfs redefines wrk-dx2  pic x(20).
               03  filler                  pic x(10).
           66  rnms renames dx2-ovdsnt thru dx2-sum.
       01 len-tst1 constant length of dx2-sum.
       01 len-tst2 constant length of wrk-dx2.
       01 len-tst3 constant length of wrk-rec.
       01 len-rnms constant length of rnms.
       01 len-rdfs constant length of rdfs.

       01 svs-1    pic x(len-tst1).
       01 svs-2    pic x(len-tst2).
       01 svs-3    pic x(len-tst3).
      * the following lines cause error because the length is 0
      *01 wrnms    pic x(len-rnms).
      *01 wrdfs    pic x(len-rdfs).

       procedure division.
           display "Const len-tst1 " len-tst1.
           display "Const len-tst2 " len-tst2.
           display "Const len-tst3 " len-tst3.
           display " ".
           display "Const len-rnms " len-rnms.
           display "Real  length   " length of rnms.
           display " ".
           display "Const len-rdfs " len-rdfs.
           display "Real  length   " length of rdfs.
           move 0 to return-code.
           stop run.
      *------------------------------------------------------------


The patch below fixes the bug.

Ehud.


diff -c ~/open-cobol-1.1/cobc/typeck.c-sv ~/open-cobol-1.1/cobc/typeck.c
*** ~/open-cobol-1.1/cobc/typeck.c-sv   Wed Jan 28 19:57:25 2009
--- ~/open-cobol-1.1/cobc/typeck.c      Mon Jun  8 18:07:58 2009
***************
*** 68,73 ****
--- 68,77 ----
        current_statement->body = cb_list_add (current_statement->body, x)
  #define cb_emit_list(l) \
        current_statement->body = cb_list_append (current_statement->body, l)
+ #define cb_validate_field_call(x)  \
+       if (!x->flag_is_verified) { cb_validate_field (x); }

  /* Global variables */

***************
*** 975,984 ****
                cb_error (_("88 level item not allowed here"));
                return cb_error_node;
        }
!       if (!f->flag_is_verified) {
!               cb_validate_field (f);
        }
-       sprintf (buff, "%d", f->memory_size);
        return cb_build_numeric_literal (0, (ucharptr)buff, 0);
  }

--- 979,996 ----
                cb_error (_("88 level item not allowed here"));
                return cb_error_node;
        }
!       if (f->redefines) {
!               /* rename / redefines */
!               cb_validate_field_call (f->redefines) ;
!               if (f->rename_thru) {
!                       cb_validate_field_call (f->rename_thru) ;
!               }
!               cb_validate_field_call (f) ;
!               sprintf (buff, "%d", f->size);
!       } else {
!               cb_validate_field_call (f) ;
!               sprintf (buff, "%d", f->memory_size);
        }
        return cb_build_numeric_literal (0, (ucharptr)buff, 0);
  }



--
 Ehud Karni           Tel: +972-3-7966-561  /"\
 Mivtach - Simon      Fax: +972-3-7966-667  \ /  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