Skip to content

Commit 927be3e

Browse files
kio-watanabekio-watanabe
authored
Add option to allow writing after the 72nd digit (#513)
1 parent 3dcaa5c commit 927be3e

File tree

6 files changed

+93
-9
lines changed

6 files changed

+93
-9
lines changed

‎cobj/cobj.c‎

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -303,6 +303,7 @@ static const struct option long_options[] = {
303303
{"free", no_argument, &cb_source_format, CB_FORMAT_FREE},
304304
{"free_1col_aster", no_argument, &cb_source_format,
305305
CB_FORMAT_FREE_1COL_ASTER},
306+
{"variable", no_argument, &cb_source_format, CB_FORMAT_VARIABLE},
306307
{"fixed", no_argument, &cb_source_format, CB_FORMAT_FIXED},
307308
{"static", no_argument, &cb_flag_static_call, 1},
308309
{"dynamic", no_argument, &cb_flag_static_call, 0},
@@ -802,6 +803,8 @@ static void cobc_print_usage(void) {
802803
puts(_(" -free Use free source format"));
803804
puts(_(" -free_1col_aster Use free(1col_aster) source "
804805
"format"));
806+
puts(_(" -variable Allow codes after 72 digits not "
807+
"to be ignored"));
805808
puts(_(" -g Enable Java compiler debug"));
806809
puts(_(" -debug Enable all run-time error "
807810
"checking"));

‎cobj/cobj.h‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -41,6 +41,7 @@
4141
#define CB_FORMAT_FIXED 0
4242
#define CB_FORMAT_FREE 1
4343
#define CB_FORMAT_FREE_1COL_ASTER 2
44+
#define CB_FORMAT_VARIABLE 3
4445

4546
extern int cb_source_format;
4647
extern int cb_source_format1;

‎cobj/pplex.c‎

Lines changed: 12 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -3707,6 +3707,9 @@ static void check_directive(char *buff, int *line_size) {
37073707
cb_source_format1 = 1;
37083708
return;
37093709
}
3710+
if (!strcasecmp(sbuff[2], "VARIABLE")) {
3711+
cb_source_format = CB_FORMAT_VARIABLE;
3712+
}
37103713
break;
37113714
default:
37123715
if (strcasecmp(sbuff[1], "FORMAT")) {
@@ -3728,6 +3731,9 @@ static void check_directive(char *buff, int *line_size) {
37283731
cb_source_format1 = 1;
37293732
return;
37303733
}
3734+
if (!strcasecmp(sbuff[3], "VARIABLE")) {
3735+
cb_source_format = CB_FORMAT_VARIABLE;
3736+
}
37313737
break;
37323738
}
37333739
cb_warning(_("Invalid directive - ignored"));
@@ -3905,6 +3911,8 @@ static void check_dollar_directive(char *buff, int *line_size) {
39053911
cb_source_format = CB_FORMAT_FREE_1COL_ASTER;
39063912
cb_source_format1 = 1;
39073913
return;
3914+
} else if (strcasecmp(sbuff[1], "SOURCEFORMAT(VARIABLE)") == 0) {
3915+
cb_source_format = CB_FORMAT_VARIABLE;
39083916
} else {
39093917
cb_compile_status = CB_COMPILE_STATUS_ERROR;
39103918
cb_error(_("Invalid $SET"));
@@ -3968,7 +3976,7 @@ static int ppinput(char *buff, int max_size) {
39683976
return strlen(buff);
39693977
}
39703978
if (n == 0 && cb_source_format != CB_FORMAT_FIXED &&
3971-
cb_source_format1 != 1) {
3979+
cb_source_format1 != 1 && cb_source_format != CB_FORMAT_VARIABLE) {
39723980
if (ipchar != ' ' && ipchar != '\n') {
39733981
buff[n++] = ' ';
39743982
}
@@ -4029,7 +4037,8 @@ static int ppinput(char *buff, int max_size) {
40294037
}
40304038

40314039
/* nothing more to do with free format */
4032-
if (cb_source_format != CB_FORMAT_FIXED) {
4040+
if (cb_source_format != CB_FORMAT_FIXED &&
4041+
cb_source_format != CB_FORMAT_VARIABLE) {
40334042
return n;
40344043
}
40354044

@@ -4117,7 +4126,7 @@ static int ppinput(char *buff, int max_size) {
41174126
}
41184127

41194128
/* check the text that is longer than cb_text_column */
4120-
if (n > cb_text_column + 1) {
4129+
if (n > cb_text_column + 1 && cb_source_format != CB_FORMAT_VARIABLE) {
41214130

41224131
/* show warning if it is not whitespaces */
41234132
if (cb_warn_column_overflow && last_line_2 < cb_source_line - 1) {

‎cobj/pplex.l‎

Lines changed: 12 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -722,6 +722,9 @@ check_directive (char *buff, int *line_size)
722722
cb_source_format1 = 1;
723723
return;
724724
}
725+
if (!strcasecmp (sbuff[2], "VARIABLE")){
726+
cb_source_format = CB_FORMAT_VARIABLE;
727+
}
725728
break;
726729
default:
727730
if (strcasecmp (sbuff[1], "FORMAT")) {
@@ -743,6 +746,9 @@ check_directive (char *buff, int *line_size)
743746
cb_source_format1 = 1;
744747
return;
745748
}
749+
if (!strcasecmp (sbuff[3], "VARIABLE")){
750+
cb_source_format = CB_FORMAT_VARIABLE;
751+
}
746752
break;
747753
}
748754
cb_warning (_("Invalid directive - ignored"));
@@ -908,6 +914,8 @@ check_dollar_directive (char *buff, int *line_size)
908914
cb_source_format = CB_FORMAT_FREE_1COL_ASTER;
909915
cb_source_format1 = 1;
910916
return;
917+
} else if (strcasecmp (sbuff[1], "SOURCEFORMAT(VARIABLE)") == 0){
918+
cb_source_format = CB_FORMAT_VARIABLE;
911919
} else {
912920
cb_compile_status = CB_COMPILE_STATUS_ERROR;
913921
cb_error (_("Invalid $SET"));
@@ -972,7 +980,8 @@ start:
972980
newline_count = 0;
973981
return strlen (buff);
974982
}
975-
if (n == 0 && cb_source_format != CB_FORMAT_FIXED && cb_source_format1 != 1) {
983+
if (n == 0 && cb_source_format != CB_FORMAT_FIXED && cb_source_format1 != 1
984+
&& cb_source_format != CB_FORMAT_VARIABLE) {
976985
if (ipchar != ' ' && ipchar != '\n') {
977986
buff[n++] = ' ';
978987
}
@@ -1033,7 +1042,7 @@ start:
10331042
}
10341043

10351044
/* nothing more to do with free format */
1036-
if (cb_source_format != CB_FORMAT_FIXED) {
1045+
if (cb_source_format != CB_FORMAT_FIXED && cb_source_format != CB_FORMAT_VARIABLE) {
10371046
return n;
10381047
}
10391048

@@ -1121,7 +1130,7 @@ start:
11211130
}
11221131

11231132
/* check the text that is longer than cb_text_column */
1124-
if (n > cb_text_column + 1) {
1133+
if (n > cb_text_column + 1 && cb_source_format != CB_FORMAT_VARIABLE) {
11251134

11261135
/* show warning if it is not whitespaces */
11271136
if (cb_warn_column_overflow && last_line_2 < cb_source_line - 1) {

‎cobj/pplex.l.m4‎

Lines changed: 12 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -737,6 +737,9 @@ check_directive (char *buff, int *line_size)
737737
cb_source_format1 = 1;
738738
return;
739739
}
740+
if (!strcasecmp (sbuff[2], "VARIABLE")){
741+
cb_source_format = CB_FORMAT_VARIABLE;
742+
}
740743
break;
741744
default:
742745
if (strcasecmp (sbuff[1], "FORMAT")) {
@@ -758,6 +761,9 @@ check_directive (char *buff, int *line_size)
758761
cb_source_format1 = 1;
759762
return;
760763
}
764+
if (!strcasecmp (sbuff[3], "VARIABLE")){
765+
cb_source_format = CB_FORMAT_VARIABLE;
766+
}
761767
break;
762768
}
763769
cb_warning (_("Invalid directive - ignored"));
@@ -923,6 +929,8 @@ check_dollar_directive (char *buff, int *line_size)
923929
cb_source_format = CB_FORMAT_FREE_1COL_ASTER;
924930
cb_source_format1 = 1;
925931
return;
932+
} else if (strcasecmp (sbuff[1], "SOURCEFORMAT(VARIABLE)") == 0){
933+
cb_source_format = CB_FORMAT_VARIABLE;
926934
} else {
927935
cb_compile_status = CB_COMPILE_STATUS_ERROR;
928936
cb_error (_("Invalid $SET"));
@@ -987,7 +995,8 @@ start:
987995
newline_count = 0;
988996
return strlen (buff);
989997
}
990-
if (n == 0 && cb_source_format != CB_FORMAT_FIXED && cb_source_format1 != 1) {
998+
if (n == 0 && cb_source_format != CB_FORMAT_FIXED && cb_source_format1 != 1
999+
&& cb_source_format != CB_FORMAT_VARIABLE) {
9911000
if (ipchar != ' ' && ipchar != '\n') {
9921001
buff[n++] = ' ';
9931002
}
@@ -1048,7 +1057,7 @@ start:
10481057
}
10491058

10501059
/* nothing more to do with free format */
1051-
if (cb_source_format != CB_FORMAT_FIXED) {
1060+
if (cb_source_format != CB_FORMAT_FIXED && cb_source_format != CB_FORMAT_VARIABLE) {
10521061
return n;
10531062
}
10541063

@@ -1136,7 +1145,7 @@ start:
11361145
}
11371146

11381147
/* check the text that is longer than cb_text_column */
1139-
if (n > cb_text_column + 1) {
1148+
if (n > cb_text_column + 1 && cb_source_format != CB_FORMAT_VARIABLE) {
11401149

11411150
/* show warning if it is not whitespaces */
11421151
if (cb_warn_column_overflow && last_line_2 < cb_source_line - 1) {

‎tests/command-line-options.src/free.at‎

Lines changed: 53 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -35,4 +35,57 @@ HELLO
3535
WORLD
3636
])
3737

38+
AT_CLEANUP
39+
40+
AT_SETUP([-variable])
41+
42+
AT_DATA([prog.cbl], [
43+
000001 IDENTIFICATION DIVISION.
44+
000002 PROGRAM-ID. prog.
45+
000003 DATA DIVISION.
46+
000004 WORKING-STORAGE SECTION.
47+
000005 PROCEDURE DIVISION.
48+
000006 DISPLAY "HELLO HELLO HELLO HELLO HELLO HELLO HELLO HELLO HELLO HELLO HELLO HELLO HELLO HELLO HELLO HELLO HELLO HELLO HELLO HELLO".
49+
])
50+
51+
AT_CHECK([${COBJ} -variable prog.cbl])
52+
AT_CHECK([${RUN_MODULE} prog], [0],
53+
[HELLO HELLO HELLO HELLO HELLO HELLO HELLO HELLO HELLO HELLO HELLO HELLO HELLO HELLO HELLO HELLO HELLO HELLO HELLO HELLO
54+
])
55+
56+
AT_DATA([prog2.cbl], [
57+
000001 IDENTIFICATION DIVISION.
58+
000002 PROGRAM-ID. prog2.
59+
000003 DATA DIVISION.
60+
000004 WORKING-STORAGE SECTION.
61+
000005PROCEDURE DIVISION.
62+
000006 STOP RUN.
63+
])
64+
65+
AT_CHECK([${COBJ} -variable prog2.cbl], [1], [],
66+
[prog2.cbl:5: Error: Invalid indicator 'P' at column 7
67+
])
68+
69+
AT_DATA([prog3.cbl], [
70+
000001 IDENTIFICATION DIVISION.
71+
000002 PROGRAM-ID. prog3.
72+
000003 DATA DIVISION.
73+
000004 WORKING-STORAGE SECTION.
74+
000005 COPY inc.
75+
000006 PROCEDURE DIVISION.
76+
000007 DISPLAY AFTER-72.
77+
000008 DISPLAY "HELLO HELLO HELLO HELLO HELLO HELLO HELLO HELLO HELLO HELLO HELLO HELLO HELLO HELLO HELLO HELLO HELLO HELLO HELLO HELLO".
78+
000009 STOP RUN.
79+
])
80+
81+
AT_DATA([inc.cpy], [
82+
000001 01 AFTER-72 PIC X(119) VALUE "HELLO HELLO HELLO HELLO HELLO HELLO HELLO HELLO HELLO HELLO HELLO HELLO HELLO HELLO HELLO HELLO HELLO HELLO HELLO HELLO".
83+
])
84+
85+
AT_CHECK([${COBJ} -variable prog3.cbl])
86+
AT_CHECK([${RUN_MODULE} prog3], [0],
87+
[HELLO HELLO HELLO HELLO HELLO HELLO HELLO HELLO HELLO HELLO HELLO HELLO HELLO HELLO HELLO HELLO HELLO HELLO HELLO HELLO
88+
HELLO HELLO HELLO HELLO HELLO HELLO HELLO HELLO HELLO HELLO HELLO HELLO HELLO HELLO HELLO HELLO HELLO HELLO HELLO HELLO
89+
])
90+
3891
AT_CLEANUP

0 commit comments

Comments
 (0)