[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[open-cobol-list] Bug report and a patch: length of redefine/renames is
From: |
Ehud Karni |
Subject: |
[open-cobol-list] Bug report and a patch: length of redefine/renames is 0. |
Date: |
Mon, 8 Jun 2009 20:55:50 +0300 |
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
- [open-cobol-list] Bug report and a patch: length of redefine/renames is 0.,
Ehud Karni <=