diff --git a/src/main/cobol/TEST-FILTER.CBL b/src/main/cobol/TEST-FILTER.CBL new file mode 100644 index 00000000..f7116fa3 --- /dev/null +++ b/src/main/cobol/TEST-FILTER.CBL @@ -0,0 +1,43 @@ + IDENTIFICATION DIVISION. + PROGRAM-ID. TEST-FILTER. + + ENVIRONMENT DIVISION. + + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 WS-TEST-VAR PIC X(10) VALUE SPACES. ABCD12 + 01 WS-COUNTER PIC 9(3) VALUE 0. + 01 WS-RESULT PIC 9(3) VALUE 0. + + PROCEDURE DIVISION. + + MAIN-PROCESS. + EJECT + + MOVE "HELLO" TO WS-TEST-VAR + MOVE 10 TO WS-COUNTER TEST1234 + + SKIP1 + + PERFORM CALCULATE-RESULT + + EJECT + + DISPLAY "Program completed successfully" + . + + PROGRAM-END. + STOP RUN. + + CALCULATE-RESULT. + SKIP2 + COMPUTE WS-RESULT = WS-COUNTER * 2 + + EJECT + + IF WS-RESULT > 15 + DISPLAY "Result is greater than 15: " WS-RESULT + ELSE + DISPLAY "Result is 15 or less: " WS-RESULT + END-IF + . \ No newline at end of file diff --git a/src/main/java/org/openmainframeproject/cobolcheck/features/interpreter/CobolReader.java b/src/main/java/org/openmainframeproject/cobolcheck/features/interpreter/CobolReader.java index d706c6bb..494dc096 100644 --- a/src/main/java/org/openmainframeproject/cobolcheck/features/interpreter/CobolReader.java +++ b/src/main/java/org/openmainframeproject/cobolcheck/features/interpreter/CobolReader.java @@ -1,6 +1,7 @@ package org.openmainframeproject.cobolcheck.features.interpreter; import org.openmainframeproject.cobolcheck.exceptions.PossibleInternalLogicErrorException; +import org.openmainframeproject.cobolcheck.services.StringHelper; import org.openmainframeproject.cobolcheck.services.cobolLogic.CobolLine; import org.openmainframeproject.cobolcheck.services.cobolLogic.Interpreter; import org.openmainframeproject.cobolcheck.services.cobolLogic.TokenExtractor; @@ -64,6 +65,15 @@ CobolLine readLine() throws IOException { if (line == null){ return null; } + + // Comment out SKIP and EJECT pagination directives that are incompatible with GnuCOBOL + if (StringHelper.shouldFilterLine(line)) { + line = StringHelper.commentOutLine(StringHelper.removeRightSideSequenceNumbers(line)); + } else { + // Always remove right-side sequence numbers from all lines to avoid processing issues + line = StringHelper.removeRightSideSequenceNumbers(line); + } + previousLine = currentLine; setPreviousMeaningfulLine(); currentLine = new CobolLine(line, tokenExtractor); @@ -214,6 +224,15 @@ CobolLine peekNextMeaningfulLine() throws IOException { if (line == null){ return null; } + + // Comment out SKIP and EJECT pagination directives that are incompatible with GnuCOBOL + if (StringHelper.shouldFilterLine(line)) { + line = StringHelper.commentOutLine(StringHelper.removeRightSideSequenceNumbers(line)); + } else { + // Always remove right-side sequence numbers from all lines to avoid processing issues + line = StringHelper.removeRightSideSequenceNumbers(line); + } + CobolLine cobolLine = new CobolLine(line, tokenExtractor); nextLines.add(cobolLine); if (Interpreter.isMeaningful(cobolLine)){ diff --git a/src/main/java/org/openmainframeproject/cobolcheck/services/Constants.java b/src/main/java/org/openmainframeproject/cobolcheck/services/Constants.java index fb037363..d7a039b2 100644 --- a/src/main/java/org/openmainframeproject/cobolcheck/services/Constants.java +++ b/src/main/java/org/openmainframeproject/cobolcheck/services/Constants.java @@ -158,6 +158,9 @@ private Constants() { public static final String PICTURE_VALUE = "PICTURE"; public static final String NUMERIC_PICTURE_CLAUSE_PATTERN = "^[\\d\\(\\)SsVv]+$"; + // COBOL line column definitions + public static final int COBOL_LINE_NUMBER_COLUMN_END = 6; + public static final int COBOL_CODE_AREA_END = 72; //Keywords not in COBOL-Code public static final String PARAGRAPH_TOKEN = "PARAGRAPH"; diff --git a/src/main/java/org/openmainframeproject/cobolcheck/services/StringHelper.java b/src/main/java/org/openmainframeproject/cobolcheck/services/StringHelper.java index 0c7bf7b6..661ba3cf 100644 --- a/src/main/java/org/openmainframeproject/cobolcheck/services/StringHelper.java +++ b/src/main/java/org/openmainframeproject/cobolcheck/services/StringHelper.java @@ -283,4 +283,57 @@ public static boolean startsWithAny(String value, Collection collection) } return false; } + + /** + * Check if a line contains SKIP or EJECT pagination directives that should be filtered out + * for GnuCOBOL compatibility + * + * @param sourceLine the COBOL source line to check + * @return true if the line should be filtered (commented out) + */ + public static boolean shouldFilterLine(String sourceLine) { + if (sourceLine == null || sourceLine.trim().isEmpty()) { + return false; + } + + String lineContent = sourceLine.trim().toUpperCase(); + + // If line has line numbers, extract the content part + if (sourceLine.length() > Constants.COBOL_LINE_NUMBER_COLUMN_END && Character.isDigit(sourceLine.charAt(0))) { + lineContent = sourceLine.substring(Constants.COBOL_LINE_NUMBER_COLUMN_END).trim().toUpperCase(); + } + + // Check if this line is EJECT or SKIP variant + return lineContent.equals("EJECT") || lineContent.startsWith("SKIP"); + } + + /** + * Remove right-side sequence numbers (columns 73-80) from COBOL source lines + * COBOL standard: columns 73-80 are identification area (right-side sequence numbers) + * Only removes content if there are actual sequence numbers beyond column 72 + * + * @param line the original COBOL line + * @return the line with right-side sequence numbers removed if they exist + */ + public static String removeRightSideSequenceNumbers(String line) { + if (line == null || line.length() <= Constants.COBOL_CODE_AREA_END) { + return line; + } + + // Extract the potential sequence number area (columns 73-80) + String sequenceArea = line.substring(Constants.COBOL_CODE_AREA_END); + + // Only remove if the sequence area contains actual sequence numbers (not just spaces) + // Sequence numbers are typically digits, or alphanumeric identifiers + String trimmedSequenceArea = sequenceArea.trim(); + if (!trimmedSequenceArea.isEmpty()) { + // Check if it looks like sequence numbers (digits, or mixed alphanumeric like "000010" or "A123") + if (trimmedSequenceArea.matches("^[A-Z0-9]+$") && trimmedSequenceArea.length() <= 8) { + return line.substring(0, Constants.COBOL_CODE_AREA_END); + } + } + + // If it's just spaces or doesn't look like sequence numbers, keep the line as-is + return line; + } } diff --git a/src/test/cobol/TEST-FILTER/Testcobollinefilter.cut b/src/test/cobol/TEST-FILTER/Testcobollinefilter.cut new file mode 100644 index 00000000..f8ceaa81 --- /dev/null +++ b/src/test/cobol/TEST-FILTER/Testcobollinefilter.cut @@ -0,0 +1,17 @@ +TestSuite "Test EJECT and SKIP handling" + +TestCase "Test basic functionality with EJECT/SKIP" + Perform MAIN-PROCESS + Expect WS-TEST-VAR = "HELLO " + Expect WS-COUNTER = 10 + Expect WS-RESULT = 20 + +TestCase "Test calculation result" + Move 5 to WS-COUNTER + Perform CALCULATE-RESULT + Expect WS-RESULT = 10 + +TestCase "Test calculation with larger number" + Move 15 to WS-COUNTER + Perform CALCULATE-RESULT + Expect WS-RESULT = 30 \ No newline at end of file diff --git a/src/test/java/org/openmainframeproject/cobolcheck/StringHelperTest.java b/src/test/java/org/openmainframeproject/cobolcheck/StringHelperTest.java index b91ee936..f0ee334f 100644 --- a/src/test/java/org/openmainframeproject/cobolcheck/StringHelperTest.java +++ b/src/test/java/org/openmainframeproject/cobolcheck/StringHelperTest.java @@ -153,4 +153,32 @@ public void it_stubs_a_line_that_starts_without_spaces_long_stub_tag() { String original = "CALL 'PROG1'."; assertEquals(expected, StringHelper.stubLine(original, "STUBBEDVALUE")); } + + // Tests for COBOL line filtering functionality + @Test + public void shouldFilterLine_identifies_EJECT_statements() { + assertTrue(StringHelper.shouldFilterLine(" EJECT")); + assertTrue(StringHelper.shouldFilterLine("000010 EJECT")); + assertFalse(StringHelper.shouldFilterLine(" CALL 'EJECT-PROG'")); + } + + @Test + public void shouldFilterLine_identifies_SKIP_statements() { + assertTrue(StringHelper.shouldFilterLine(" SKIP1")); + assertTrue(StringHelper.shouldFilterLine(" SKIP")); + assertFalse(StringHelper.shouldFilterLine(" DISPLAY 'SKIP THIS'")); + } + + @Test + public void removeRightSideSequenceNumbers_removes_sequence_numbers() { + String withSeqNum = " MOVE 1 TO A. 000010"; + String expected = " MOVE 1 TO A. "; + assertEquals(expected, StringHelper.removeRightSideSequenceNumbers(withSeqNum)); + } + + @Test + public void removeRightSideSequenceNumbers_preserves_normal_lines() { + String normal = " MOVE 1 TO A. "; + assertEquals(normal, StringHelper.removeRightSideSequenceNumbers(normal)); + } } diff --git a/src/test/java/org/openmainframeproject/cobolcheck/features/interpreter/CobolReaderLineFilteringTest.java b/src/test/java/org/openmainframeproject/cobolcheck/features/interpreter/CobolReaderLineFilteringTest.java new file mode 100644 index 00000000..1de22cae --- /dev/null +++ b/src/test/java/org/openmainframeproject/cobolcheck/features/interpreter/CobolReaderLineFilteringTest.java @@ -0,0 +1,81 @@ +package org.openmainframeproject.cobolcheck.features.interpreter; + +import org.junit.jupiter.api.Test; +import org.openmainframeproject.cobolcheck.services.cobolLogic.CobolLine; + +import java.io.BufferedReader; +import java.io.IOException; +import java.io.StringReader; + +import static org.junit.jupiter.api.Assertions.*; + +/** + * Simple integration tests for COBOL line filtering in CobolReader + */ +public class CobolReaderLineFilteringTest { + + @Test + public void testEjectStatementIsCommentedOut() throws IOException { + String cobolSource = String.join(System.lineSeparator(), + " IDENTIFICATION DIVISION.", + " EJECT", + " DATA DIVISION." + ); + + BufferedReader bufferedReader = new BufferedReader(new StringReader(cobolSource)); + CobolReader cobolReader = new CobolReader(bufferedReader); + + CobolLine line1 = cobolReader.readLine(); + assertEquals(" IDENTIFICATION DIVISION.", line1.getOriginalString()); + + CobolLine line2 = cobolReader.readLine(); + assertEquals(" *EJECT", line2.getOriginalString()); // Should be commented out + + CobolLine line3 = cobolReader.readLine(); + assertEquals(" DATA DIVISION.", line3.getOriginalString()); + + cobolReader.close(); + } + + @Test + public void testSkipStatementIsCommentedOut() throws IOException { + String cobolSource = String.join(System.lineSeparator(), + " PROCEDURE DIVISION.", + " SKIP1", + " DISPLAY 'HELLO'." + ); + + BufferedReader bufferedReader = new BufferedReader(new StringReader(cobolSource)); + CobolReader cobolReader = new CobolReader(bufferedReader); + + CobolLine line1 = cobolReader.readLine(); + assertEquals(" PROCEDURE DIVISION.", line1.getOriginalString()); + + CobolLine line2 = cobolReader.readLine(); + assertEquals(" *SKIP1", line2.getOriginalString()); // Should be commented out + + CobolLine line3 = cobolReader.readLine(); + assertEquals(" DISPLAY 'HELLO'.", line3.getOriginalString()); + + cobolReader.close(); + } + + @Test + public void testSequenceNumbersAreRemoved() throws IOException { + String cobolSource = String.join(System.lineSeparator(), + " MOVE 1 TO A. 000010", + " DISPLAY 'TEST'. ABC123" + ); + + BufferedReader bufferedReader = new BufferedReader(new StringReader(cobolSource)); + CobolReader cobolReader = new CobolReader(bufferedReader); + + CobolLine line1 = cobolReader.readLine(); + assertEquals(" MOVE 1 TO A. ", line1.getOriginalString()); + + CobolLine line2 = cobolReader.readLine(); + assertEquals(" DISPLAY 'TEST'. ", line2.getOriginalString()); + + cobolReader.close(); + } +} diff --git a/testruns/testResults.txt b/testruns/testResults.txt new file mode 100644 index 00000000..29c4ce1e --- /dev/null +++ b/testruns/testResults.txt @@ -0,0 +1,17 @@ +TESTSUITE: +Test EJECT and SKIP handling +Result is greater than 15: 020 +Program completed successfully + PASS: 1. Test basic functionality with EJECT/SKIP + PASS: 2. Test basic functionality with EJECT/SKIP + PASS: 3. Test basic functionality with EJECT/SKIP +Result is 15 or less: 010 + PASS: 4. Test calculation result +Result is greater than 15: 030 + PASS: 5. Test calculation with larger number + + 5 TEST CASES WERE EXECUTED + 5 PASSED + 0 FAILED + 0 CALLS NOT MOCKED +=================================================