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
+185 −35
Open

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

Show file tree
Hide file tree
Changes from 4 commits
Commits
Show all changes
6 commits
Select commit Hold shift + click to select a range
d6aa13e
COMP-X displayed with 3 characters when size is one byte
emilienlemaire Dec 18, 2024
93fb963
Move test
emilienlemaire Dec 18, 2024
0422dfe
Promote tests manually
emilienlemaire Dec 18, 2024
d764aa7
Update changelog
emilienlemaire Dec 18, 2024
f9b5d9c
Edit test + fall-through comment
emilienlemaire Dec 19, 2024
745d02b
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
21 changes: 21 additions & 0 deletions cobc/ChangeLog
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,4 +1,25 @@

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

* 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
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
22 changes: 17 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,16 @@ 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;
}
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 +2958,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 +2990,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 +3069,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
6 changes: 6 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 @@ -4135,6 +4137,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 +4156,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
Copy link
Collaborator

Choose a reason for hiding this comment

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

All of those changes are either unnecessary or at the wrong place - CB_USAGE_COMP_X is never to be of CB_CATEGORY_ALPHANUMERIC (only it's ->pic could) but has always to be CB_CATEGORY_NUMERIC.

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
44 changes: 22 additions & 22 deletions tests/testsuite.src/run_file.at
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -8747,26 +8747,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 @@ -10992,32 +10992,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:0/048
READ NEXT STATUS:0/048
DATA:SEQ01 -
READ NEXT STATUS:0/48
READ NEXT STATUS:0/048
DATA:SEQ02 -
READ NEXT STATUS:0/48
READ NEXT STATUS:0/048
DATA:SEQ03 -
READ NEXT STATUS:0/48
READ NEXT STATUS:0/048
DATA:SEQ04 -
READ NEXT STATUS:0/48
READ NEXT STATUS:0/048
DATA:SEQ05 -
READ NEXT STATUS:1/48
READ NEXT STATUS:1/048
DATA: -
CLOSE STATUS:0/48
OPEN STATUS:0/48
READ NEXT STATUS:0/48
CLOSE STATUS:0/048
OPEN STATUS:0/048
READ NEXT STATUS:0/048
DATA:TXTA123456-
READ NEXT STATUS:0/48
READ NEXT STATUS:0/048
DATA:TXTB123456-
READ NEXT STATUS:0/48
READ NEXT STATUS:0/048
DATA:TXTC123456-
READ NEXT STATUS:0/48
READ NEXT STATUS:0/048
DATA:TXTD123456-
READ NEXT STATUS:1/48
READ NEXT STATUS:1/048
DATA: -
CLOSE STATUS:0/48
CLOSE STATUS:0/048
emilienlemaire marked this conversation as resolved.
Show resolved Hide resolved
], [])

AT_CLEANUP
Expand Down
42 changes: 40 additions & 2 deletions tests/testsuite.src/run_misc.at
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -10594,7 +10594,7 @@ WORKING-STORAGE
**********************
77 RETURN-CODE +000000000
01 ZRO 000000000
01 HEXV 13
01 HEXV 013
01 TEST-BASED. <NULL> address
01 TEST-ALLOCED.
05 TEST-ALLOCED-SUB1 ALL SPACES
Expand Down Expand Up @@ -10658,7 +10658,7 @@ WORKING-STORAGE
**********************
77 RETURN-CODE +000000000
01 ZRO 000000000
01 HEXV 13
01 HEXV 013
01 IDX 000000000
01 TSTREC.
05 TSTDEP 'XXX'
Expand Down Expand Up @@ -15132,3 +15132,41 @@ AT_CHECK([COB_PROF_ENABLE=1 COB_PROF_FILE=prof.csv $COBCRUN_DIRECT ./caller], [0
])

AT_CLEANUP


AT_SETUP([display COMP-X of one byte])
emilienlemaire marked this conversation as resolved.
Show resolved Hide resolved
AT_KEYWORDS([display comp-x])
emilienlemaire marked this conversation as resolved.
Show resolved Hide resolved

AT_DATA([prog.cob], [
IDENTIFICATION DIVISION.
PROGRAM-ID. prog.

DATA DIVISION.
WORKING-STORAGE SECTION.

01 W-X PIC X COMP-X VALUE 99.
01 W-Y PIC X COMP-X VALUE 128.
01 W-Z PIC X VALUE "z".
01 W-ZR REDEFINES W-Z PIC X COMP-X.

PROCEDURE DIVISION.
MAIN.
DISPLAY FUNCTION BYTE-LENGTH (W-X).
DISPLAY FUNCTION BYTE-LENGTH (W-Y).
DISPLAY FUNCTION BYTE-LENGTH (W-ZR).
DISPLAY W-X.
DISPLAY W-Y.
DISPLAY W-ZR.
STOP RUN.
])

AT_CHECK([$COMPILE prog.cob])
AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [1
1
1
099
128
122
], [])

AT_CLEANUP
Loading