Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

COMP-X displayed with number of characters from maximum value #205

Open
wants to merge 6 commits into
base: gcos4gnucobol-3.x
Choose a base branch
from
Open

COMP-X displayed with number of characters from maximum value #205

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
6 commits
Select commit Hold shift + click to select a range
590f5a3
COMP-X displayed with 3 characters when size is one byte
emilienlemaire Dec 18, 2024
a5cd198
Move test
emilienlemaire Dec 18, 2024
9a23266
Promote tests manually
emilienlemaire Dec 18, 2024
66902f7
Update changelog
emilienlemaire Dec 18, 2024
24ad0c7
Edit test + fall-through comment
emilienlemaire Dec 19, 2024
5870488
Update
emilienlemaire Dec 20, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
27 changes: 27 additions & 0 deletions cobc/ChangeLog
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,4 +1,27 @@

2024-12-18 Emilien Lemaire <[email protected]>

* cobgen.c, field.c, tree.c, tree.h, typeck.c: Hand merge 2015-07-02
about COMP-X.
* cobgen.c (output_size): use `compx_size` when usage is COMP-X
* cobgen.c (output_attr): override type to `COB_TYPE_NUMERIC_BINARY`
when usage is `COMP-X`
* field.c: Increment `pic_digits` values by one
* field.c (setup_parameters): set the `compx_size` and override usage
of `COMP-N` to `COMP-X` field when picture starts with `X`
* field.c (compute_size): leave `align_size` to 1 when usage is
`COMP-x` and use `compx_size` to compute size of `COMP-X`
* tree.c (cb_tree_category): `COMP-X` is of category
`CB_CATEGORY_NUMERIC`.
* tree.c (cb_field_size): size of `COMP-X` field and references is
`compx_size`
* tree.h (struct cob_field): add `compx_size` to `cob_field`
* typeck.c (cb_check_numeric_name): `COMP-X` is numeric name
* typeck.c (cb_check_numeric_edited_name): `COMP-X` is numeric edited
name
* typeck.c (validate_move): `COMP-x` is validated when dst is category
`ALPHANUMERIC` or `ALPHANUMERIC-EDITED`.

2022-12-08 Simon Sobisch <[email protected]>

* cobc.c (process_command_line): fix leak for --copy and -include parsing
Expand Down Expand Up @@ -7304,6 +7327,10 @@
* codegen.c (output_size): Fix Bug #146 reference modification
ignored ODO size

2015-07-02 Ron Norman
* Fixes to tree.c, tree,h typeck.c field.c codegen.c to correctly
handle COMP-X data fields. This now works the same as Micro Focus

2015-06-12 Edward Hart <[email protected]>

* codegen.c: bug #78 - changed location of initialization of
Expand Down
4 changes: 4 additions & 0 deletions cobc/codegen.c
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1344,6 +1344,8 @@ output_size (const cb_tree x)
}
output_integer (p->depending);
q = p;
} else if(q->usage == CB_USAGE_COMP_X && q->compx_size > 0) {
output ("%d", q->compx_size);
} else {
output ("%d", q->size);
}
Expand Down Expand Up @@ -1603,6 +1605,8 @@ output_attr (const cb_tree x)
id = lookup_attr (COB_TYPE_ALPHANUMERIC, 0, 0, 0, NULL, 0);
} else {
int type = cb_tree_type (x, f);
if (f->usage == CB_USAGE_COMP_X)
type = COB_TYPE_NUMERIC_BINARY;
switch (type) {
case COB_TYPE_GROUP:
case COB_TYPE_ALPHANUMERIC:
Expand Down
23 changes: 18 additions & 5 deletions cobc/field.c
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -59,7 +59,7 @@ size_t cb_needs_01 = 0;

static struct cb_field *last_real_field = NULL;
static int occur_align_size = 0;
static const unsigned char pic_digits[] = { 2, 4, 7, 9, 12, 14, 16, 18 };
static const unsigned char pic_digits[] = { 3, 5, 8, 10, 13, 15, 17, 19 };
#define CB_MAX_OPS 32
static int op_pos = 1, op_val_pos;
static char op_type [CB_MAX_OPS+1];
Expand Down Expand Up @@ -2518,9 +2518,17 @@ setup_parameters (struct cb_field *f)
case CB_USAGE_COMP_5:
f->flag_real_binary = 1;
/* Fall-through */
case CB_USAGE_COMP_X:
case CB_USAGE_COMP_N:
if (f->pic->category == CB_CATEGORY_ALPHANUMERIC) {
if (f->pic
&& f->pic->orig
&& f->pic->orig[0] == 'X') {
f->usage = CB_USAGE_COMP_X;
}
/* Fall-through */
case CB_USAGE_COMP_X:
emilienlemaire marked this conversation as resolved.
Show resolved Hide resolved
if (f->pic->category == CB_CATEGORY_ALPHANUMERIC
&& f->usage == CB_USAGE_COMP_X) {
f->compx_size = f->size = f->pic->size;
if (f->pic->size > 8) {
f->pic = cb_build_picture ("9(36)");
} else {
Expand Down Expand Up @@ -2951,8 +2959,6 @@ compute_size (struct cb_field *f)
switch (c->usage) {
case CB_USAGE_BINARY:
case CB_USAGE_COMP_5:
case CB_USAGE_COMP_X:
case CB_USAGE_COMP_N:
case CB_USAGE_FLOAT:
case CB_USAGE_DOUBLE:
case CB_USAGE_LONG_DOUBLE:
Expand Down Expand Up @@ -2985,6 +2991,9 @@ compute_size (struct cb_field *f)
case CB_USAGE_PROGRAM_POINTER:
align_size = sizeof (void *);
break;
case CB_USAGE_COMP_X:
case CB_USAGE_COMP_N:
break;
default:
break;
}
Expand Down Expand Up @@ -3061,6 +3070,10 @@ compute_size (struct cb_field *f)

switch (f->usage) {
case CB_USAGE_COMP_X:
if (f->compx_size > 0) {
size = f->compx_size;
break;
}
case CB_USAGE_COMP_N:
if (f->pic->category == CB_CATEGORY_ALPHANUMERIC) {
break;
Expand Down
9 changes: 9 additions & 0 deletions cobc/tree.c
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1461,6 +1461,8 @@ cb_tree_category (cb_tree x)
x->category = CB_CATEGORY_DATA_POINTER;
} else if (f->usage == CB_USAGE_PROGRAM_POINTER) {
x->category = CB_CATEGORY_PROGRAM_POINTER;
} else if (f->usage == CB_USAGE_COMP_X) {
x->category = CB_CATEGORY_NUMERIC;
} else if (f->pic) {
x->category = f->pic->category;
/* FIXME: Hack for CGI to not abort */
Expand Down Expand Up @@ -1531,6 +1533,9 @@ cb_tree_type (const cb_tree x, const struct cb_field *f)
switch (CB_TREE_CATEGORY (x)) {
case CB_CATEGORY_ALPHABETIC:
case CB_CATEGORY_ALPHANUMERIC:
if (f->usage == CB_USAGE_COMP_X) {
return COB_TYPE_NUMERIC_BINARY;
}
return COB_TYPE_ALPHANUMERIC;
case CB_CATEGORY_ALPHANUMERIC_EDITED:
return COB_TYPE_ALPHANUMERIC_EDITED;
Expand Down Expand Up @@ -4135,6 +4140,8 @@ cb_field_size (const cb_tree x)
if (f->flag_any_length) {
return FIELD_SIZE_UNKNOWN;
}
if (f->usage == CB_USAGE_COMP_X && f->compx_size > 0)
return f->compx_size;
return f->size;
}
case CB_TAG_REFERENCE: {
Expand All @@ -4152,6 +4159,8 @@ cb_field_size (const cb_tree x)
} else {
return FIELD_SIZE_UNKNOWN;
}
} else if (f->usage == CB_USAGE_COMP_X && f->compx_size > 0) {
return f->compx_size;
} else if (f->flag_any_length) {
return FIELD_SIZE_UNKNOWN;
} else {
Expand Down
1 change: 1 addition & 0 deletions cobc/tree.h
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -914,6 +914,7 @@ struct cb_field {
int size; /* Field size */
int level; /* Level number */
int memory_size; /* Memory size */
int compx_size; /* Original COMP-X byte size */
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Couldn't we just use f->pic->size for this rarely used definition, instead of adding an extra field to all variables?

int offset; /* Byte offset from 01 level */
int occurs_min; /* OCCURS <min> */
int occurs_max; /* OCCURS [... TO] <max> */
Expand Down
18 changes: 18 additions & 0 deletions cobc/typeck.c
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -916,6 +916,13 @@ cb_check_numeric_name (cb_tree x)
return x;
}

if (CB_REFERENCE_P (x)
&& CB_FIELD_P (cb_ref (x))) {
const struct cb_field *f = CB_FIELD_PTR (x);
if (f->usage == CB_USAGE_COMP_X)
return x;
}

cb_error_x (x, _("'%s' is not a numeric name"), cb_name (x));
return cb_error_node;
}
Expand All @@ -939,6 +946,14 @@ cb_check_numeric_edited_name (cb_tree x)
}
}

if (CB_REFERENCE_P(x)
&& CB_FIELD_P(cb_ref(x))) {
const struct cb_field *f = CB_FIELD_PTR (x);
if (f->usage == CB_USAGE_COMP_X) {
return x;
}
}

cb_error_x (x, _("'%s' is not a numeric or numeric-edited name"), cb_name (x));
return cb_error_node;
}
Expand Down Expand Up @@ -11224,6 +11239,9 @@ validate_move (cb_tree src, cb_tree dst, const unsigned int is_value, int *move_
switch (CB_TREE_CATEGORY (dst)) {
case CB_CATEGORY_ALPHANUMERIC:
case CB_CATEGORY_ALPHANUMERIC_EDITED:
if (fdst->usage == CB_USAGE_COMP_X) {
break;
}
if (is_value
|| l->scale != 0
|| l->size != fdst->size) {
Expand Down
56 changes: 28 additions & 28 deletions tests/testsuite.src/run_file.at
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -8807,26 +8807,26 @@ AT_CAPTURE_FILE([prog.out])

AT_CHECK([$COBCRUN_DIRECT ./prog 1>prog.out], [0], [], [])

AT_DATA([reference], [Other Flags 32.
AT_DATA([reference], [Other Flags 032.
File has 0003 keys.
Key def 0112 bytes.
File assigned is 'mytstisam'
*** Dump FCD before changes
Key1 has 001 parts, Offset 062 Flags 00 Comp 00 Sparse .
Key1 has 001 parts, Offset 062 Flags 000 Comp 000 Sparse .
Pos 000000000 Len 000000008
Key2 has 002 parts, Offset 072 Flags 00 Comp 00 Sparse .
Key2 has 002 parts, Offset 072 Flags 000 Comp 000 Sparse .
Pos 000000109 Len 000000010
Pos 000000144 Len 000000008
Key3 has 002 parts, Offset 092 Flags 00 Comp 00 Sparse .
Key3 has 002 parts, Offset 092 Flags 000 Comp 000 Sparse .
Pos 000000156 Len 000000008
Pos 000000164 Len 000000008
*** Dump FCD after changes
Key1 has 001 parts, Offset 062 Flags 00 Comp 00 Sparse .
Key1 has 001 parts, Offset 062 Flags 000 Comp 000 Sparse .
Pos 000000000 Len 000000008
Key2 has 002 parts, Offset 072 Flags 64 Comp 00 Sparse .
Key2 has 002 parts, Offset 072 Flags 064 Comp 000 Sparse .
Pos 000000109 Len 000000010
Pos 000000144 Len 000000008
Key3 has 002 parts, Offset 092 Flags 66 Comp 00 Sparse *.
Key3 has 002 parts, Offset 092 Flags 066 Comp 000 Sparse *.
Pos 000000156 Len 000000008
Pos 000000164 Len 000000008
Loading sample file 'myextisam'
Expand Down Expand Up @@ -10997,7 +10997,7 @@ AT_DATA([prog.cob], [
MOVE 5 TO FCD-MAX-REC-LENGTH.
CALL "EXTFH" USING OPCODE, FCD.
DISPLAY "OPEN STATUS:"
FCD-STATUS-KEY-1 "/" FCD-BINARY.
FCD-FILE-STATUS.

* READ RECORD
MOVE OP-READ-NEXT TO OPCODE.
Expand All @@ -11006,15 +11006,15 @@ AT_DATA([prog.cob], [
MOVE SPACE TO EX-RECORD-BUFFER
CALL "EXTFH" USING OPCODE, FCD
DISPLAY "READ NEXT STATUS:"
FCD-STATUS-KEY-1 "/" FCD-BINARY
FCD-FILE-STATUS
DISPLAY "DATA:" EX-RECORD-BUFFER(1:10) '-'
END-PERFORM.

* CLOSE FILE
MOVE OP-CLOSE TO OPCODE.
CALL "EXTFH" USING OPCODE, FCD.
DISPLAY "CLOSE STATUS:"
FCD-STATUS-KEY-1 "/" FCD-BINARY.
FCD-FILE-STATUS.

* OPEN second file
MOVE fcd--line-sequential-org TO FCD-ORGANIZATION.
Expand All @@ -11026,7 +11026,7 @@ AT_DATA([prog.cob], [
MOVE 10 TO FCD-MAX-REC-LENGTH.
CALL "EXTFH" USING OPCODE, FCD.
DISPLAY "OPEN STATUS:"
FCD-STATUS-KEY-1 "/" FCD-BINARY.
FCD-FILE-STATUS.

* READ RECORD
MOVE OP-READ-NEXT TO OPCODE.
Expand All @@ -11035,15 +11035,15 @@ AT_DATA([prog.cob], [
MOVE SPACE TO EX-RECORD-BUFFER
CALL "EXTFH" USING OPCODE, FCD
DISPLAY "READ NEXT STATUS:"
FCD-STATUS-KEY-1 "/" FCD-BINARY
FCD-FILE-STATUS
DISPLAY "DATA:" EX-RECORD-BUFFER(1:10) '-'
END-PERFORM.

* CLOSE FILE
MOVE OP-CLOSE TO OPCODE.
CALL "EXTFH" USING OPCODE, FCD.
DISPLAY "CLOSE STATUS:"
FCD-STATUS-KEY-1 "/" FCD-BINARY.
FCD-FILE-STATUS.

MAIN-EXT.
STOP RUN.
Expand All @@ -11052,32 +11052,32 @@ AT_DATA([prog.cob], [
AT_CHECK([$COMPILE prog.cob], [0], [], [])

AT_CHECK([$COBCRUN_DIRECT ./prog], [0],
[OPEN STATUS:0/48
READ NEXT STATUS:0/48
[OPEN STATUS:00
READ NEXT STATUS:00
DATA:SEQ01 -
READ NEXT STATUS:0/48
READ NEXT STATUS:00
DATA:SEQ02 -
READ NEXT STATUS:0/48
READ NEXT STATUS:00
DATA:SEQ03 -
READ NEXT STATUS:0/48
READ NEXT STATUS:00
DATA:SEQ04 -
READ NEXT STATUS:0/48
READ NEXT STATUS:00
DATA:SEQ05 -
READ NEXT STATUS:1/48
READ NEXT STATUS:10
DATA: -
CLOSE STATUS:0/48
OPEN STATUS:0/48
READ NEXT STATUS:0/48
CLOSE STATUS:00
OPEN STATUS:00
READ NEXT STATUS:00
DATA:TXTA123456-
READ NEXT STATUS:0/48
READ NEXT STATUS:00
DATA:TXTB123456-
READ NEXT STATUS:0/48
READ NEXT STATUS:00
DATA:TXTC123456-
READ NEXT STATUS:0/48
READ NEXT STATUS:00
DATA:TXTD123456-
READ NEXT STATUS:1/48
READ NEXT STATUS:10
DATA: -
CLOSE STATUS:0/48
CLOSE STATUS:00
], [])

AT_CLEANUP
Expand Down
Loading
Loading