Skip to content

Commit

Permalink
Fix binary size computation for binary-size=2-4-8
Browse files Browse the repository at this point in the history
  • Loading branch information
ddeclerck committed Oct 30, 2024
1 parent 480b5fd commit 63c7630
Show file tree
Hide file tree
Showing 5 changed files with 169 additions and 104 deletions.
12 changes: 12 additions & 0 deletions NEWS
Original file line number Diff line number Diff line change
Expand Up @@ -33,6 +33,18 @@ NEWS - user visible changes -*- outline -*-
patterns where invalid numerical data (e.g, SPACES) encode "absent"
data

** #NNN: dialects without support of single byte binary data
will now generate at least 2 bytes of storage for COMP-5 elements; this
applies to all non-standard dialects but GnuCOBOL (default) and Micro Focus;
that changes the group length of records containing elements with less than
3 digits and also passes different sizes via CALL, which may need program
adjustments.

** -std=acu / -std=acu-strict now generate BINARY and COMP-5 with at least
2 bytes of storage; the comment for #NNN above applies; if you want
to still use the sizes used since GnuCOBOL 2.2 with those dialects:
add -fbinary-size=1-2-4-8 to your compile options

* Important Bugfixes

** #904: MOVE PACKED-DECIMAL unsigned to signed led to bad sign
Expand Down
6 changes: 6 additions & 0 deletions cobc/ChangeLog
Original file line number Diff line number Diff line change
@@ -1,4 +1,10 @@

2024-10-29 Simon Sobisch <[email protected]>

* field.c (validate_elementary_item): only set flag_real_binary for
BINARY-CHAR/BINARY-SHORT/BINARY-LONG/BINARY-DOUBLE
* codegenc (output_attr): generate COB_FLAG_REAL_BINARY also for COMP-5

2024-10-02 Simon Sobisch <[email protected]>

* pplex.l (output_line_directive): extracted from other places and
Expand Down
27 changes: 14 additions & 13 deletions cobc/codegen.c
Original file line number Diff line number Diff line change
Expand Up @@ -1630,27 +1630,28 @@ output_attr (const cb_tree x)
if (f->flag_binary_swap) {
flags |= COB_FLAG_BINARY_SWAP;
}
if (f->flag_real_binary) {
if (f->flag_real_binary
|| f->usage == CB_USAGE_COMP_5) {
flags |= COB_FLAG_REAL_BINARY;
}
if (f->flag_is_pointer) {
flags |= COB_FLAG_IS_POINTER;
}
if (cb_binary_truncate &&
f->usage == CB_USAGE_BINARY &&
!f->flag_real_binary) {
if (cb_binary_truncate
&& f->usage == CB_USAGE_BINARY
&& !f->flag_real_binary) {
flags |= COB_FLAG_BINARY_TRUNC;
}

if (type == COB_TYPE_NUMERIC_BINARY
&& f->usage == CB_USAGE_INDEX) {
flags |= COB_FLAG_REAL_BINARY;
type = COB_TYPE_NUMERIC_COMP5;
} else
if (type == COB_TYPE_NUMERIC_BINARY
&& (f->flag_binary_swap || f->flag_real_binary)
&& (f->flag_indexed_by || f->index_type || f->flag_internal_register)) {
type = COB_TYPE_NUMERIC_COMP5;
if (type == COB_TYPE_NUMERIC_BINARY) {
if (f->usage == CB_USAGE_INDEX) {
flags |= COB_FLAG_REAL_BINARY;
type = COB_TYPE_NUMERIC_COMP5;
} else
if ((f->flag_binary_swap || f->flag_real_binary)
&& (f->flag_indexed_by || f->index_type || f->flag_internal_register)) {
type = COB_TYPE_NUMERIC_COMP5;
}
}
switch (f->usage) {
case CB_USAGE_COMP_6:
Expand Down
5 changes: 0 additions & 5 deletions cobc/field.c
Original file line number Diff line number Diff line change
Expand Up @@ -2269,9 +2269,6 @@ validate_elementary_item (struct cb_field *f)
f->pic = cb_build_binary_picture ("BINARY-DOUBLE", 18, 0);
f->flag_real_binary = 1;
break;
case CB_USAGE_COMP_5:
f->flag_real_binary = 1;
break;
default:
break;
}
Expand Down Expand Up @@ -2516,8 +2513,6 @@ setup_parameters (struct cb_field *f)
break;

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) {
Expand Down
223 changes: 137 additions & 86 deletions tests/testsuite.src/data_binary.at
Original file line number Diff line number Diff line change
Expand Up @@ -2267,6 +2267,57 @@ AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], [])
AT_CLEANUP


AT_SETUP([Fixed BINARY size])
AT_KEYWORDS([binary])

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

DATA DIVISION.
WORKING-STORAGE SECTION.
01 WS-BCS BINARY-CHAR SIGNED.
01 WS-BCU BINARY-CHAR UNSIGNED.
01 WS-BSS BINARY-SHORT SIGNED.
01 WS-BSU BINARY-SHORT UNSIGNED.
01 WS-BLS BINARY-LONG SIGNED.
01 WS-BLU BINARY-LONG UNSIGNED.
01 WS-BDS BINARY-DOUBLE SIGNED.
01 WS-BDU BINARY-DOUBLE UNSIGNED.

PROCEDURE DIVISION.
MAIN.
IF BYTE-LENGTH(WS-BCS) <> 1
DISPLAY "BAD BINARY-CHAR SIGNED".
IF BYTE-LENGTH(WS-BCU) <> 1
DISPLAY "BAD BINARY-CHAR UNSIGNED".
IF BYTE-LENGTH(WS-BSS) <> 2
DISPLAY "BAD BINARY-SHORT SIGNED".
IF BYTE-LENGTH(WS-BSU) <> 2
DISPLAY "BAD BINARY-SHORT UNSIGNED".
IF BYTE-LENGTH(WS-BLS) <> 4
DISPLAY "BAD BINARY-LONG SIGNED".
IF BYTE-LENGTH(WS-BLU) <> 4
DISPLAY "BAD BINARY-LONG UNSIGNED".
IF BYTE-LENGTH(WS-BDS) <> 8
DISPLAY "BAD BINARY-DOUBLE SIGNED".
IF BYTE-LENGTH(WS-BDU) <> 8
DISPLAY "BAD BINARY-DOUBLE UNSIGNED".
STOP RUN.
])

AT_CHECK([$COMPILE -fintrinsics=ALL -Wno-constant-expression -fbinary-size=1-2-4-8 prog.cob], [0], [], [])
AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], [])

AT_CHECK([$COMPILE -fintrinsics=ALL -Wno-constant-expression -fbinary-size=2-4-8 prog.cob], [0], [], [])
AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], [])

AT_CHECK([$COMPILE -fintrinsics=ALL -Wno-constant-expression -fbinary-size=1--8 prog.cob], [0], [], [])
AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], [])

AT_CLEANUP


AT_SETUP([COMP-5 binary size])
AT_KEYWORDS([binary])

Expand Down Expand Up @@ -2355,86 +2406,86 @@ AT_DATA([prog.cob], [

PROCEDURE DIVISION.
MAIN.
DISPLAY "V9(1): " FUNCTION BYTE-LENGTH (WS-1).
DISPLAY "V9(2): " FUNCTION BYTE-LENGTH (WS-2).
DISPLAY "V9(3): " FUNCTION BYTE-LENGTH (WS-3).
DISPLAY "V9(4): " FUNCTION BYTE-LENGTH (WS-4).
DISPLAY "V9(5): " FUNCTION BYTE-LENGTH (WS-5).
DISPLAY "V9(6): " FUNCTION BYTE-LENGTH (WS-6).
DISPLAY "V9(7): " FUNCTION BYTE-LENGTH (WS-7).
DISPLAY "V9(8): " FUNCTION BYTE-LENGTH (WS-8).
DISPLAY "V9(9): " FUNCTION BYTE-LENGTH (WS-9).
DISPLAY "V9(10): " FUNCTION BYTE-LENGTH (WS-10).
DISPLAY "V9(11): " FUNCTION BYTE-LENGTH (WS-11).
DISPLAY "V9(12): " FUNCTION BYTE-LENGTH (WS-12).
DISPLAY "V9(13): " FUNCTION BYTE-LENGTH (WS-13).
DISPLAY "V9(14): " FUNCTION BYTE-LENGTH (WS-14).
DISPLAY "V9(15): " FUNCTION BYTE-LENGTH (WS-15).
DISPLAY "V9(16): " FUNCTION BYTE-LENGTH (WS-16).
DISPLAY "V9(17): " FUNCTION BYTE-LENGTH (WS-17).
DISPLAY "V9(18): " FUNCTION BYTE-LENGTH (WS-18).

DISPLAY "VPP9(1): " FUNCTION BYTE-LENGTH (WS-P1).
DISPLAY "VPP9(2): " FUNCTION BYTE-LENGTH (WS-P2).
DISPLAY "VPP9(3): " FUNCTION BYTE-LENGTH (WS-P3).
DISPLAY "VPP9(4): " FUNCTION BYTE-LENGTH (WS-P4).
DISPLAY "VPP9(5): " FUNCTION BYTE-LENGTH (WS-P5).
DISPLAY "VPP9(6): " FUNCTION BYTE-LENGTH (WS-P6).
DISPLAY "VPP9(7): " FUNCTION BYTE-LENGTH (WS-P7).
DISPLAY "VPP9(8): " FUNCTION BYTE-LENGTH (WS-P8).
DISPLAY "VPP9(9): " FUNCTION BYTE-LENGTH (WS-P9).
DISPLAY "VPP9(10): " FUNCTION BYTE-LENGTH (WS-P10).
DISPLAY "VPP9(11): " FUNCTION BYTE-LENGTH (WS-P11).
DISPLAY "VPP9(12): " FUNCTION BYTE-LENGTH (WS-P12).
DISPLAY "VPP9(13): " FUNCTION BYTE-LENGTH (WS-P13).
DISPLAY "VPP9(14): " FUNCTION BYTE-LENGTH (WS-P14).
DISPLAY "VPP9(15): " FUNCTION BYTE-LENGTH (WS-P15).
DISPLAY "VPP9(16): " FUNCTION BYTE-LENGTH (WS-P16).
DISPLAY "VPP9(17): " FUNCTION BYTE-LENGTH (WS-P17).
DISPLAY "VPP9(18): " FUNCTION BYTE-LENGTH (WS-P18).

DISPLAY "SV9(1): " FUNCTION BYTE-LENGTH (WS-S1).
DISPLAY "SV9(2): " FUNCTION BYTE-LENGTH (WS-S2).
DISPLAY "SV9(3): " FUNCTION BYTE-LENGTH (WS-S3).
DISPLAY "SV9(4): " FUNCTION BYTE-LENGTH (WS-S4).
DISPLAY "SV9(5): " FUNCTION BYTE-LENGTH (WS-S5).
DISPLAY "SV9(6): " FUNCTION BYTE-LENGTH (WS-S6).
DISPLAY "SV9(7): " FUNCTION BYTE-LENGTH (WS-S7).
DISPLAY "SV9(8): " FUNCTION BYTE-LENGTH (WS-S8).
DISPLAY "SV9(9): " FUNCTION BYTE-LENGTH (WS-S9).
DISPLAY "SV9(10): " FUNCTION BYTE-LENGTH (WS-S10).
DISPLAY "SV9(11): " FUNCTION BYTE-LENGTH (WS-S11).
DISPLAY "SV9(12): " FUNCTION BYTE-LENGTH (WS-S12).
DISPLAY "SV9(13): " FUNCTION BYTE-LENGTH (WS-S13).
DISPLAY "SV9(14): " FUNCTION BYTE-LENGTH (WS-S14).
DISPLAY "SV9(15): " FUNCTION BYTE-LENGTH (WS-S15).
DISPLAY "SV9(16): " FUNCTION BYTE-LENGTH (WS-S16).
DISPLAY "SV9(17): " FUNCTION BYTE-LENGTH (WS-S17).
DISPLAY "SV9(18): " FUNCTION BYTE-LENGTH (WS-S18).

DISPLAY "SVPP9(1): " FUNCTION BYTE-LENGTH (WS-SP1).
DISPLAY "SVPP9(2): " FUNCTION BYTE-LENGTH (WS-SP2).
DISPLAY "SVPP9(3): " FUNCTION BYTE-LENGTH (WS-SP3).
DISPLAY "SVPP9(4): " FUNCTION BYTE-LENGTH (WS-SP4).
DISPLAY "SVPP9(5): " FUNCTION BYTE-LENGTH (WS-SP5).
DISPLAY "SVPP9(6): " FUNCTION BYTE-LENGTH (WS-SP6).
DISPLAY "SVPP9(7): " FUNCTION BYTE-LENGTH (WS-SP7).
DISPLAY "SVPP9(8): " FUNCTION BYTE-LENGTH (WS-SP8).
DISPLAY "SVPP9(9): " FUNCTION BYTE-LENGTH (WS-SP9).
DISPLAY "SVPP9(10): " FUNCTION BYTE-LENGTH (WS-SP10).
DISPLAY "SVPP9(11): " FUNCTION BYTE-LENGTH (WS-SP11).
DISPLAY "SVPP9(12): " FUNCTION BYTE-LENGTH (WS-SP12).
DISPLAY "SVPP9(13): " FUNCTION BYTE-LENGTH (WS-SP13).
DISPLAY "SVPP9(14): " FUNCTION BYTE-LENGTH (WS-SP14).
DISPLAY "SVPP9(15): " FUNCTION BYTE-LENGTH (WS-SP15).
DISPLAY "SVPP9(16): " FUNCTION BYTE-LENGTH (WS-SP16).
DISPLAY "SVPP9(17): " FUNCTION BYTE-LENGTH (WS-SP17).
DISPLAY "SVPP9(18): " FUNCTION BYTE-LENGTH (WS-SP18).
DISPLAY "V9(1): " BYTE-LENGTH (WS-1).
DISPLAY "V9(2): " BYTE-LENGTH (WS-2).
DISPLAY "V9(3): " BYTE-LENGTH (WS-3).
DISPLAY "V9(4): " BYTE-LENGTH (WS-4).
DISPLAY "V9(5): " BYTE-LENGTH (WS-5).
DISPLAY "V9(6): " BYTE-LENGTH (WS-6).
DISPLAY "V9(7): " BYTE-LENGTH (WS-7).
DISPLAY "V9(8): " BYTE-LENGTH (WS-8).
DISPLAY "V9(9): " BYTE-LENGTH (WS-9).
DISPLAY "V9(10): " BYTE-LENGTH (WS-10).
DISPLAY "V9(11): " BYTE-LENGTH (WS-11).
DISPLAY "V9(12): " BYTE-LENGTH (WS-12).
DISPLAY "V9(13): " BYTE-LENGTH (WS-13).
DISPLAY "V9(14): " BYTE-LENGTH (WS-14).
DISPLAY "V9(15): " BYTE-LENGTH (WS-15).
DISPLAY "V9(16): " BYTE-LENGTH (WS-16).
DISPLAY "V9(17): " BYTE-LENGTH (WS-17).
DISPLAY "V9(18): " BYTE-LENGTH (WS-18).

DISPLAY "VPP9(1): " BYTE-LENGTH (WS-P1).
DISPLAY "VPP9(2): " BYTE-LENGTH (WS-P2).
DISPLAY "VPP9(3): " BYTE-LENGTH (WS-P3).
DISPLAY "VPP9(4): " BYTE-LENGTH (WS-P4).
DISPLAY "VPP9(5): " BYTE-LENGTH (WS-P5).
DISPLAY "VPP9(6): " BYTE-LENGTH (WS-P6).
DISPLAY "VPP9(7): " BYTE-LENGTH (WS-P7).
DISPLAY "VPP9(8): " BYTE-LENGTH (WS-P8).
DISPLAY "VPP9(9): " BYTE-LENGTH (WS-P9).
DISPLAY "VPP9(10): " BYTE-LENGTH (WS-P10).
DISPLAY "VPP9(11): " BYTE-LENGTH (WS-P11).
DISPLAY "VPP9(12): " BYTE-LENGTH (WS-P12).
DISPLAY "VPP9(13): " BYTE-LENGTH (WS-P13).
DISPLAY "VPP9(14): " BYTE-LENGTH (WS-P14).
DISPLAY "VPP9(15): " BYTE-LENGTH (WS-P15).
DISPLAY "VPP9(16): " BYTE-LENGTH (WS-P16).
DISPLAY "VPP9(17): " BYTE-LENGTH (WS-P17).
DISPLAY "VPP9(18): " BYTE-LENGTH (WS-P18).

DISPLAY "SV9(1): " BYTE-LENGTH (WS-S1).
DISPLAY "SV9(2): " BYTE-LENGTH (WS-S2).
DISPLAY "SV9(3): " BYTE-LENGTH (WS-S3).
DISPLAY "SV9(4): " BYTE-LENGTH (WS-S4).
DISPLAY "SV9(5): " BYTE-LENGTH (WS-S5).
DISPLAY "SV9(6): " BYTE-LENGTH (WS-S6).
DISPLAY "SV9(7): " BYTE-LENGTH (WS-S7).
DISPLAY "SV9(8): " BYTE-LENGTH (WS-S8).
DISPLAY "SV9(9): " BYTE-LENGTH (WS-S9).
DISPLAY "SV9(10): " BYTE-LENGTH (WS-S10).
DISPLAY "SV9(11): " BYTE-LENGTH (WS-S11).
DISPLAY "SV9(12): " BYTE-LENGTH (WS-S12).
DISPLAY "SV9(13): " BYTE-LENGTH (WS-S13).
DISPLAY "SV9(14): " BYTE-LENGTH (WS-S14).
DISPLAY "SV9(15): " BYTE-LENGTH (WS-S15).
DISPLAY "SV9(16): " BYTE-LENGTH (WS-S16).
DISPLAY "SV9(17): " BYTE-LENGTH (WS-S17).
DISPLAY "SV9(18): " BYTE-LENGTH (WS-S18).

DISPLAY "SVPP9(1): " BYTE-LENGTH (WS-SP1).
DISPLAY "SVPP9(2): " BYTE-LENGTH (WS-SP2).
DISPLAY "SVPP9(3): " BYTE-LENGTH (WS-SP3).
DISPLAY "SVPP9(4): " BYTE-LENGTH (WS-SP4).
DISPLAY "SVPP9(5): " BYTE-LENGTH (WS-SP5).
DISPLAY "SVPP9(6): " BYTE-LENGTH (WS-SP6).
DISPLAY "SVPP9(7): " BYTE-LENGTH (WS-SP7).
DISPLAY "SVPP9(8): " BYTE-LENGTH (WS-SP8).
DISPLAY "SVPP9(9): " BYTE-LENGTH (WS-SP9).
DISPLAY "SVPP9(10): " BYTE-LENGTH (WS-SP10).
DISPLAY "SVPP9(11): " BYTE-LENGTH (WS-SP11).
DISPLAY "SVPP9(12): " BYTE-LENGTH (WS-SP12).
DISPLAY "SVPP9(13): " BYTE-LENGTH (WS-SP13).
DISPLAY "SVPP9(14): " BYTE-LENGTH (WS-SP14).
DISPLAY "SVPP9(15): " BYTE-LENGTH (WS-SP15).
DISPLAY "SVPP9(16): " BYTE-LENGTH (WS-SP16).
DISPLAY "SVPP9(17): " BYTE-LENGTH (WS-SP17).
DISPLAY "SVPP9(18): " BYTE-LENGTH (WS-SP18).

STOP RUN.
])

AT_CHECK([$COMPILE -fbinary-size=1-2-4-8 prog.cob], [0], [], [])
AT_CHECK([$COMPILE -fintrinsics=ALL -fbinary-size=1-2-4-8 prog.cob], [0], [], [])
AT_CHECK([$COBCRUN_DIRECT ./prog], [0],
[V9(1): 1
V9(2): 1
Expand Down Expand Up @@ -2510,10 +2561,10 @@ SVPP9(17): 8
SVPP9(18): 8
], [])

AT_CHECK([$COMPILE -fbinary-size=2-4-8 prog.cob], [0], [], [])
AT_CHECK([$COMPILE -fintrinsics=ALL -fbinary-size=2-4-8 prog.cob], [0], [], [])
AT_CHECK([$COBCRUN_DIRECT ./prog], [0],
[V9(1): 1
V9(2): 1
[V9(1): 2
V9(2): 2
V9(3): 2
V9(4): 2
V9(5): 4
Expand All @@ -2530,8 +2581,8 @@ V9(15): 8
V9(16): 8
V9(17): 8
V9(18): 8
VPP9(1): 1
VPP9(2): 1
VPP9(1): 2
VPP9(2): 2
VPP9(3): 2
VPP9(4): 2
VPP9(5): 4
Expand All @@ -2548,8 +2599,8 @@ VPP9(15): 8
VPP9(16): 8
VPP9(17): 8
VPP9(18): 8
SV9(1): 1
SV9(2): 1
SV9(1): 2
SV9(2): 2
SV9(3): 2
SV9(4): 2
SV9(5): 4
Expand All @@ -2566,8 +2617,8 @@ SV9(15): 8
SV9(16): 8
SV9(17): 8
SV9(18): 8
SVPP9(1): 1
SVPP9(2): 1
SVPP9(1): 2
SVPP9(2): 2
SVPP9(3): 2
SVPP9(4): 2
SVPP9(5): 4
Expand All @@ -2586,7 +2637,7 @@ SVPP9(17): 8
SVPP9(18): 8
], [])

AT_CHECK([$COMPILE -fbinary-size=1--8 prog.cob], [0], [], [])
AT_CHECK([$COMPILE -fintrinsics=ALL -fbinary-size=1--8 prog.cob], [0], [], [])
AT_CHECK([$COBCRUN_DIRECT ./prog], [0],
[V9(1): 1
V9(2): 1
Expand Down

0 comments on commit 63c7630

Please sign in to comment.