diff --git a/cobc/ChangeLog b/cobc/ChangeLog index fea626e9a..70be6aa26 100644 --- a/cobc/ChangeLog +++ b/cobc/ChangeLog @@ -1,5 +1,21 @@ -2022-12-08 Simon Sobisch +2025-01-06 Fabrice Le Fessant + + * parser.y (rule occurs_index): set index_type to CB_INT_INDEX + also for INDEXED BY appaering in LINKAGE SECTION, otherwise + the variable is not added to the local include file + +2025-01-03 Fabrice Le Fessant + + * typeck.c (build_evaluate, cb_check_needs_break): fix a bug where + EVALUATE fails in profiling mode. The reason was that a check for + a last GOTO statement is not correctly written, because it was + actually checking either a GOTO or not a statement, which was + evaluates to true for instructions added by profiling. Fixed by + checking only that the last statement is a GOTO. Also modify + cb_check_needs_break that uses the same code. + +2024-12-08 Simon Sobisch * cobc.c (process_command_line): fix leak for --copy and -include parsing diff --git a/cobc/parser.y b/cobc/parser.y index 6293848c0..501bb2d65 100644 --- a/cobc/parser.y +++ b/cobc/parser.y @@ -8569,7 +8569,8 @@ occurs_index: const cb_tree init_val = cb_default_byte == CB_DEFAULT_BYTE_INIT ? cb_int1 : NULL; $$ = cb_build_index ($1, init_val, 1U, current_field); - if (storage == CB_STORAGE_LOCAL) { + if (storage == CB_STORAGE_LOCAL || + storage == CB_STORAGE_LINKAGE) { CB_FIELD_PTR ($$)->index_type = CB_INT_INDEX; } else { CB_FIELD_PTR ($$)->index_type = CB_STATIC_INT_INDEX; diff --git a/cobc/typeck.c b/cobc/typeck.c index 280fa922d..af66ca8a1 100644 --- a/cobc/typeck.c +++ b/cobc/typeck.c @@ -797,6 +797,7 @@ static cb_tree cb_check_needs_break (cb_tree stmt) { cb_tree l; + int needs_a_break = 1 ; /* Check if last statement is GO TO */ for (l = stmt; l; l = CB_CHAIN (l)) { @@ -806,12 +807,15 @@ cb_check_needs_break (cb_tree stmt) } if (l && CB_VALUE (l) && CB_STATEMENT_P (CB_VALUE (l))) { l = CB_STATEMENT(CB_VALUE(l))->body; - if (l && CB_VALUE (l) && !CB_GOTO_P (CB_VALUE(l))) { - /* Append a break */ - l = cb_build_direct ("break;", 0); - return cb_list_add (stmt, l); + if (l && CB_VALUE (l) && CB_GOTO_P (CB_VALUE(l))) { + needs_a_break = 0; } } + + if (needs_a_break){ + l = cb_build_direct ("break;", 0); + return cb_list_add (stmt, l); + } return stmt; } @@ -10019,6 +10023,7 @@ build_evaluate (cb_tree subject_list, cb_tree case_list, cb_tree goto_end_label) cb_source_line = old_line; } else { + int need_end_goto = 1 ; c2 = stmt; /* Check if last statement is GO TO */ for (c3 = stmt; c3; c3 = CB_CHAIN (c3)) { @@ -10028,11 +10033,14 @@ build_evaluate (cb_tree subject_list, cb_tree case_list, cb_tree goto_end_label) } if (c3 && CB_VALUE (c3) && CB_STATEMENT_P (CB_VALUE (c3))) { c3 = CB_STATEMENT (CB_VALUE (c3))->body; - if (c3 && CB_VALUE (c3) && !CB_GOTO_P (CB_VALUE(c3))) { - /* Append the jump */ - c2 = cb_list_add (stmt, goto_end_label); + if (c3 && CB_VALUE (c3) && CB_GOTO_P (CB_VALUE(c3))) { + need_end_goto = 0 ; } } + if (need_end_goto){ + /* Append the jump */ + c2 = cb_list_add (stmt, goto_end_label); + } cb_emit (cb_build_if (cb_build_cond (c1), c2, NULL, STMT_WHEN)); build_evaluate (subject_list, CB_CHAIN (case_list), goto_end_label); } diff --git a/tests/testsuite.src/run_misc.at b/tests/testsuite.src/run_misc.at index 69dfde687..f6daa4033 100644 --- a/tests/testsuite.src/run_misc.at +++ b/tests/testsuite.src/run_misc.at @@ -15251,3 +15251,324 @@ AT_CHECK([$COMPILE prog.cob]) AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [1.2345E-5 1.2345E-5], []) AT_CLEANUP + + +AT_SETUP([profiling and codegen]) +AT_KEYWORDS([EVALUATE]) + +AT_DATA([prog.cob], [ +IDENTIFICATION DIVISION. +PROGRAM-ID. PROG. + +DATA DIVISION. +WORKING-STORAGE SECTION. + 01 STR PIC X(6) VALUE "..-..-". + 01 OFFSET BINARY-LONG UNSIGNED. + +PROCEDURE DIVISION. + MOVE 1 TO OFFSET + PERFORM UNTIL OFFSET > LENGTH OF STR + CALL "TestRecurse" USING STR OFFSET + END-PERFORM. + +END PROGRAM PROG. + + +IDENTIFICATION DIVISION. +PROGRAM-ID. TestRecurse IS RECURSIVE. + +DATA DIVISION. +LINKAGE SECTION. + 01 LK-STR PIC X ANY LENGTH. + 01 LK-OFFSET BINARY-LONG UNSIGNED. + +PROCEDURE DIVISION USING LK-STR LK-OFFSET. + DISPLAY "LK-OFFSET: " LK-OFFSET + EVALUATE LK-STR(LK-OFFSET:1) + WHEN "." + ADD 1 TO LK-OFFSET + CALL "TestRecurse" USING LK-STR LK-OFFSET + WHEN OTHER + ADD 1 TO LK-OFFSET + END-EVALUATE. + +END PROGRAM TestRecurse. +]) + +AT_CHECK([$COMPILE --free prog.cob]) + +AT_CHECK([$COBCRUN_DIRECT ./prog], [0], +[LK-OFFSET: 0000000001 +LK-OFFSET: 0000000002 +LK-OFFSET: 0000000003 +LK-OFFSET: 0000000004 +LK-OFFSET: 0000000005 +LK-OFFSET: 0000000006 +]) + +AT_CHECK([$COMPILE --free -fprof prog.cob]) + +AT_CHECK([$COBCRUN_DIRECT ./prog], [0], +[LK-OFFSET: 0000000001 +LK-OFFSET: 0000000002 +LK-OFFSET: 0000000003 +LK-OFFSET: 0000000004 +LK-OFFSET: 0000000005 +LK-OFFSET: 0000000006 +]) +AT_DATA([prog.cob], [ + IDENTIFICATION DIVISION. + PROGRAM-ID. PROG. + + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 STR PIC X(6) VALUE "..-..-". + 01 OFFSET BINARY-LONG UNSIGNED. + + PROCEDURE DIVISION. + MOVE 1 TO OFFSET + PERFORM UNTIL OFFSET > LENGTH OF STR + CALL "TestRecurse" USING STR OFFSET + END-PERFORM. + + END PROGRAM PROG. + + + IDENTIFICATION DIVISION. + PROGRAM-ID. TestRecurse IS RECURSIVE. + + DATA DIVISION. + LINKAGE SECTION. + 01 LK-STR. + 03 LK-CHR PIC X OCCURS 6 INDEXED BY LK-IDX. + 01 LK-OFFSET BINARY-LONG UNSIGNED. + + PROCEDURE DIVISION USING LK-STR LK-OFFSET. + DISPLAY "LK-OFFSET: " LK-OFFSET + SET LK-IDX TO LK-OFFSET + SEARCH LK-CHR + AT END + IF LK-OFFSET > 20 + GOBACK + END-IF + ADD 1 TO LK-OFFSET + CALL "TestRecurse" USING LK-STR LK-OFFSET + WHEN LK-CHR (LK-IDX) = "." + ADD 1 TO LK-OFFSET + END-SEARCH. + END PROGRAM TestRecurse. +]) + +AT_CHECK([$COMPILE --free prog.cob]) + +AT_CHECK([$COBCRUN_DIRECT ./prog], [0], +[LK-OFFSET: 0000000001 +LK-OFFSET: 0000000002 +LK-OFFSET: 0000000003 +LK-OFFSET: 0000000004 +LK-OFFSET: 0000000005 +LK-OFFSET: 0000000006 +LK-OFFSET: 0000000007 +LK-OFFSET: 0000000008 +LK-OFFSET: 0000000009 +LK-OFFSET: 0000000010 +LK-OFFSET: 0000000011 +LK-OFFSET: 0000000012 +LK-OFFSET: 0000000013 +LK-OFFSET: 0000000014 +LK-OFFSET: 0000000015 +LK-OFFSET: 0000000016 +LK-OFFSET: 0000000017 +LK-OFFSET: 0000000018 +LK-OFFSET: 0000000019 +LK-OFFSET: 0000000020 +LK-OFFSET: 0000000021 +]) + +AT_CHECK([$COMPILE --free -fprof prog.cob]) + +AT_CHECK([$COBCRUN_DIRECT ./prog], [0], +[LK-OFFSET: 0000000001 +LK-OFFSET: 0000000002 +LK-OFFSET: 0000000003 +LK-OFFSET: 0000000004 +LK-OFFSET: 0000000005 +LK-OFFSET: 0000000006 +LK-OFFSET: 0000000007 +LK-OFFSET: 0000000008 +LK-OFFSET: 0000000009 +LK-OFFSET: 0000000010 +LK-OFFSET: 0000000011 +LK-OFFSET: 0000000012 +LK-OFFSET: 0000000013 +LK-OFFSET: 0000000014 +LK-OFFSET: 0000000015 +LK-OFFSET: 0000000016 +LK-OFFSET: 0000000017 +LK-OFFSET: 0000000018 +LK-OFFSET: 0000000019 +LK-OFFSET: 0000000020 +LK-OFFSET: 0000000021 +]) + +AT_CHECK([COB_PROF_ENABLE=1 COB_PROF_FORMAT="%m,%s,%p,%e,%w,%k,%n" COB_PROF_FILE="prof.csv" $COBCRUN_DIRECT ./prog], +[0],[LK-OFFSET: 0000000001 +LK-OFFSET: 0000000002 +LK-OFFSET: 0000000003 +LK-OFFSET: 0000000004 +LK-OFFSET: 0000000005 +LK-OFFSET: 0000000006 +LK-OFFSET: 0000000007 +LK-OFFSET: 0000000008 +LK-OFFSET: 0000000009 +LK-OFFSET: 0000000010 +LK-OFFSET: 0000000011 +LK-OFFSET: 0000000012 +LK-OFFSET: 0000000013 +LK-OFFSET: 0000000014 +LK-OFFSET: 0000000015 +LK-OFFSET: 0000000016 +LK-OFFSET: 0000000017 +LK-OFFSET: 0000000018 +LK-OFFSET: 0000000019 +LK-OFFSET: 0000000020 +LK-OFFSET: 0000000021 +], +[File prof.csv generated +]) + +AT_CHECK([cat prof.csv], [0], [program-id,section,paragraph,entry,location,kind,ncalls +TestRecurse,,,,prog.cob:28,PROGRAM,21 +TestRecurse,MAIN SECTION,,,prog.cob:29,SECTION,21 +TestRecurse,MAIN SECTION,MAIN PARAGRAPH,,prog.cob:29,PARAGRAPH,21 +TestRecurse,MAIN SECTION,MAIN PARAGRAPH,TestRecurse,prog.cob:37,CALL,15 +PROG,,,,prog.cob:10,PROGRAM,1 +PROG,MAIN SECTION,,,prog.cob:11,SECTION,1 +PROG,MAIN SECTION,MAIN PARAGRAPH,,prog.cob:11,PARAGRAPH,1 +PROG,MAIN SECTION,MAIN PARAGRAPH,TestRecurse,prog.cob:13,CALL,6 +], []) + + +AT_CLEANUP + + +AT_SETUP([INDEXED BY in LINKAGE]) + +AT_KEYWORDS([runmisc OCCURS SEARCH]) + +AT_DATA([callee.cob], [ + IDENTIFICATION DIVISION. + PROGRAM-ID. callee. + DATA DIVISION. + LINKAGE SECTION. + 01 LK-STR. + 03 LK-CHR PIC X OCCURS 6 INDEXED BY LK-IDX. + 01 LK-OFFSET BINARY-LONG UNSIGNED. + PROCEDURE DIVISION USING LK-STR LK-OFFSET. + DISPLAY "LK-OFFSET: " LK-OFFSET. + SET LK-IDX TO LK-OFFSET. + SEARCH LK-CHR + AT END + IF LK-OFFSET > 20 + GOBACK + END-IF + ADD 1 TO LK-OFFSET + WHEN LK-CHR (LK-IDX) = "." + ADD 1 TO LK-OFFSET + END-SEARCH. + EXIT PROGRAM. +]) + +AT_DATA([caller.cob], [ + IDENTIFICATION DIVISION. + PROGRAM-ID. caller. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 STR PIC X(6) VALUE "..-..-". + 01 OFFSET BINARY-LONG UNSIGNED. + PROCEDURE DIVISION. + MOVE 1 TO OFFSET. + PERFORM UNTIL OFFSET > LENGTH OF STR + CALL "callee" USING STR OFFSET + END-PERFORM. +]) + +AT_CHECK([$COMPILE_MODULE callee.cob], [0], [], []) +AT_CHECK([$COMPILE -o prog caller.cob], [0], [], []) +AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [LK-OFFSET: 0000000001 +LK-OFFSET: 0000000002 +LK-OFFSET: 0000000003 +LK-OFFSET: 0000000004 +LK-OFFSET: 0000000005 +LK-OFFSET: 0000000006 +], []) + +AT_CLEANUP + + +AT_SETUP([profiling RECURSIVE CALL]) + +AT_DATA([prog.cob], [ + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 WS-COUNTER PIC 9. + PROCEDURE DIVISION. + MOVE 0 TO WS-COUNTER. + CALL "recurse" USING WS-COUNTER. + STOP RUN. + END PROGRAM prog. + + IDENTIFICATION DIVISION. + PROGRAM-ID. recurse IS RECURSIVE. + DATA DIVISION. + LINKAGE SECTION. + 01 LK-COUNTER PIC 9. + PROCEDURE DIVISION USING LK-COUNTER. + DISPLAY "COUNTER:" LK-COUNTER. + EVALUATE LK-COUNTER + WHEN 5 + EXIT PROGRAM + WHEN OTHER + ADD 1 TO LK-COUNTER + CALL "recurse" USING LK-COUNTER + END-EVALUATE. + END PROGRAM recurse. +]) + +AT_CHECK([$COMPILE --free -fprof prog.cob]) + +AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [COUNTER:0 +COUNTER:1 +COUNTER:2 +COUNTER:3 +COUNTER:4 +COUNTER:5 +], []) + +AT_CHECK([COB_PROF_ENABLE=1 COB_PROF_FORMAT="%m,%s,%p,%e,%w,%k,%n" COB_PROF_FILE="prof.csv" $COBCRUN_DIRECT ./prog], +[0], +[COUNTER:0 +COUNTER:1 +COUNTER:2 +COUNTER:3 +COUNTER:4 +COUNTER:5 +], +[File prof.csv generated +]) + +AT_CHECK([cat prof.csv], [0], [program-id,section,paragraph,entry,location,kind,ncalls +recurse,,,,prog.cob:18,PROGRAM,6 +recurse,MAIN SECTION,,,prog.cob:19,SECTION,6 +recurse,MAIN SECTION,MAIN PARAGRAPH,,prog.cob:19,PARAGRAPH,6 +recurse,MAIN SECTION,MAIN PARAGRAPH,recurse,prog.cob:25,CALL,5 +prog,,,,prog.cob:7,PROGRAM,1 +prog,MAIN SECTION,,,prog.cob:8,SECTION,1 +prog,MAIN SECTION,MAIN PARAGRAPH,,prog.cob:8,PARAGRAPH,1 +prog,MAIN SECTION,MAIN PARAGRAPH,recurse,prog.cob:9,CALL,1 +], []) + +AT_CLEANUP +