From 2d1b367f17c0836723a064bbdc61c0d7a67bcd45 Mon Sep 17 00:00:00 2001 From: ChristopherRyan-GM Date: Wed, 3 Dec 2025 09:52:15 +0000 Subject: [PATCH] Handle Linkage Section and Entry/Using clause Signed-off-by: ChristopherRyan-GM --- src/main/cobol/TEST-LINKAGE.CBL | 38 ++++++++ .../cobolcheck/workers/Generator.java | 90 ++++++++++++++++++- .../cobol/TEST-LINKAGE/TestLinkageSection.cut | 11 +++ 3 files changed, 138 insertions(+), 1 deletion(-) create mode 100644 src/main/cobol/TEST-LINKAGE.CBL create mode 100644 src/test/cobol/TEST-LINKAGE/TestLinkageSection.cut diff --git a/src/main/cobol/TEST-LINKAGE.CBL b/src/main/cobol/TEST-LINKAGE.CBL new file mode 100644 index 00000000..e2bb835d --- /dev/null +++ b/src/main/cobol/TEST-LINKAGE.CBL @@ -0,0 +1,38 @@ + ***************************************************************** + * TEST PROGRAM FOR LINKAGE SECTION, PROCEDURE DIVISION USING + ***************************************************************** + IDENTIFICATION DIVISION. + PROGRAM-ID. TEST-LINKAGE. + ENVIRONMENT DIVISION. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 WS-COUNTER PIC 9(04) VALUE 0. + 01 WS-WORK-AREA PIC X(20). + LINKAGE SECTION. + 01 L-IOPCB. + 05 L-DBD-NAME PIC X(08). + 05 L-SEGMENT-LEVEL PIC X(02). + 05 L-STATUS-CODE PIC X(02). + 01 IMSVAR01 PIC X(100). + 01 IMSVAR02 PIC X(200). + 01 IMSVAR03 PIC X(300). + 01 IMSVAR04 PIC X(400). + ***************************************************************** + * P R O C E D U R E D I V I S I O N * + ***************************************************************** + PROCEDURE DIVISION USING L-IOPCB + IMSVAR01 + IMSVAR02 + IMSVAR03 + IMSVAR04. + 0000-MAIN. + ADD 1 TO WS-COUNTER + MOVE 'MAIN ENTRY' TO WS-WORK-AREA. + ENTRY 'DLITCBL' USING L-IOPCB + IMSVAR01 + IMSVAR02 + IMSVAR03 + IMSVAR04. + 0100-ENTRY-POINT. + ADD 10 TO WS-COUNTER + MOVE 'ENTRY POINT' TO WS-WORK-AREA. \ No newline at end of file diff --git a/src/main/java/org/openmainframeproject/cobolcheck/workers/Generator.java b/src/main/java/org/openmainframeproject/cobolcheck/workers/Generator.java index 207beea9..3ffe80b2 100644 --- a/src/main/java/org/openmainframeproject/cobolcheck/workers/Generator.java +++ b/src/main/java/org/openmainframeproject/cobolcheck/workers/Generator.java @@ -35,6 +35,8 @@ public class Generator { private WriterController writerController; private TestSuiteParserController testSuiteParserController; private boolean workingStorageHasEnded; + private boolean skipUsingClauseLines = false; + private boolean skipEntryStatementLines = false; List matchingTestDirectories; @@ -200,7 +202,11 @@ private void writeToSource(String sourceLine) throws IOException { writerController.writeStubbedLine(sourceLine); } else { - writerController.writeLine(sourceLine); + // Fix for LINKAGE SECTION and PROCEDURE DIVISION USING issues + String modifiedLine = processLinkageSectionFix(sourceLine); + if(modifiedLine != null){ + writerController.writeLine(modifiedLine); + } } } } @@ -257,6 +263,88 @@ private void closeReadersAndWriters(String programName) { writerController.closeWriter(programName); } + /** + * Processes source lines to fix LINKAGE SECTION and PROCEDURE DIVISION + USING issues. + * Also handles ENTRY statements that reference LINKAGE SECTION variables. + * + * @param sourceLine - The original source line + * @return The modified source line, or null if the line should be skipped + */ + private String processLinkageSectionFix(String sourceLine) { + // Skip LINKAGE SECTION line entirely + if (interpreter.currentLineContains(Constants.LINKAGE_SECTION)) { + return null; // Skip this line + } + + // Skip lines that are part of a multi-line USING clause + if (skipUsingClauseLines) { + // Check if this line ends the USING clause (contains a period) + String trimmedLine = sourceLine.trim(); + if (trimmedLine.endsWith(".")) { + skipUsingClauseLines = false; // Stop skipping after this line + } + return null; // Skip this line + } + + // Skip lines that are part of a multi-line ENTRY statement + if (skipEntryStatementLines) { + // Check if this line ends the ENTRY statement (contains a period) + String trimmedLine = sourceLine.trim(); + if (trimmedLine.endsWith(".")) { + skipEntryStatementLines = false; // Stop skipping after this line + } + return null; // Skip this line - comment it out + } + + // Handle PROCEDURE DIVISION with USING clause + if (interpreter.currentLineContains(Constants.PROCEDURE_DIVISION)) { + // Find the position of "USING" in the line (case insensitive) + String upperLine = sourceLine.toUpperCase(); + int usingIndex = upperLine.indexOf("USING"); + if (usingIndex != -1) { + // Check if the USING clause ends on the same line + if (!sourceLine.trim().endsWith(".")) { + // Multi-line USING clause - set flag to skip subsequent lines + skipUsingClauseLines = true; + } + // Extract the sequence number area (first 6 characters) and indentation + String sequenceArea = sourceLine.length() > 6 ? sourceLine.substring(0, 6) : " "; + String lineContent = sourceLine.length() > 6 ? sourceLine.substring(6) : ""; + + // Find the start of "PROCEDURE DIVISION" in the content area + String upperContent = lineContent.toUpperCase(); + int procIndex = upperContent.indexOf("PROCEDURE DIVISION"); + if (procIndex != -1) { + // Preserve the indentation before "PROCEDURE DIVISION" + String indentation = lineContent.substring(0, procIndex); + String formattedLine = sequenceArea + indentation + "PROCEDURE DIVISION."; + return formattedLine; + } else { + // Fallback: just remove USING and add period + String beforeUsing = sourceLine.substring(0, usingIndex).trim(); + return beforeUsing + "."; + } + } + } + + // Handle ENTRY statements - comment them out entirely since they reference LINKAGE SECTION variables + String upperLine = sourceLine.toUpperCase(); + if (upperLine.contains("ENTRY")) { + // Check if this is actually an ENTRY statement (not just the word "ENTRY" in a comment) + String contentArea = sourceLine.length() > 6 ? sourceLine.substring(6).trim() : sourceLine.trim(); + if (contentArea.toUpperCase().startsWith("ENTRY ")) { + // Check if the ENTRY statement ends on the same line + if (!sourceLine.trim().endsWith(".")) { + // Multi-line ENTRY statement - set flag to skip subsequent lines + skipEntryStatementLines = true; + } + return null; // Skip this line entirely (effectively commenting it out) + } + } + return sourceLine; // Return original line if no modification needed + } + private void writeWhenOtherSectionOrParagraph(String sourceLine) throws IOException{ writerController.writeLines(testSuiteParserController.generateWhenOtherSectionOrParagraph(currentMockType, interpreter.getSectionOrParagraphLines(), sourceLine, currentIdentifier, true)); } diff --git a/src/test/cobol/TEST-LINKAGE/TestLinkageSection.cut b/src/test/cobol/TEST-LINKAGE/TestLinkageSection.cut new file mode 100644 index 00000000..c116e5d3 --- /dev/null +++ b/src/test/cobol/TEST-LINKAGE/TestLinkageSection.cut @@ -0,0 +1,11 @@ +TestSuite "Test Entry Statement Fix" + TestCase "Main entry point test" + MOVE 0 TO WS-COUNTER + PERFORM 0000-MAIN + EXPECT WS-COUNTER TO BE 1 + EXPECT WS-WORK-AREA TO BE 'MAIN ENTRY' + TestCase "Entry point after main test" + MOVE 0 TO WS-COUNTER + PERFORM 0100-ENTRY-POINT + EXPECT WS-COUNTER TO BE 10 + EXPECT WS-WORK-AREA TO BE 'ENTRY POINT'