diff --git a/src/main/cobol/MOCK.CBL b/src/main/cobol/MOCK.CBL index 58a3d2e3..433c381f 100644 --- a/src/main/cobol/MOCK.CBL +++ b/src/main/cobol/MOCK.CBL @@ -2,9 +2,9 @@ PROGRAM-ID. MOCK. /**************************************************************** * Program to exercise different mock statements and edge cases. - ***************************************************************** + ***************************************************************** ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. + INPUT-OUTPUT SECTION. FILE-CONTROL. DATA DIVISION. WORKING-STORAGE SECTION. @@ -23,10 +23,10 @@ 000-START SECTION. MOVE "Value1" to VALUE-1 - MOVE "Value2" to VALUE-2 + MOVE "Value2" to VALUE-2 dadawdwd / - PERFORM 100-WELCOME - PERFORM 200-GOODBYE + PERFORM 100-WELCOME dadadada + PERFORM 200-GOODBYE dadadada / PERFORM 300-CHANGE-1 PERFORM 400-CHANGE-2 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..db7b0ccf 100644 --- a/src/main/java/org/openmainframeproject/cobolcheck/features/interpreter/CobolReader.java +++ b/src/main/java/org/openmainframeproject/cobolcheck/features/interpreter/CobolReader.java @@ -4,7 +4,6 @@ import org.openmainframeproject.cobolcheck.services.cobolLogic.CobolLine; import org.openmainframeproject.cobolcheck.services.cobolLogic.Interpreter; import org.openmainframeproject.cobolcheck.services.cobolLogic.TokenExtractor; - import java.io.*; import java.util.ArrayList; import java.util.List; @@ -24,7 +23,7 @@ public class CobolReader { private String lineJustEntered = null; private final int maxLineLength = 72; - + public CobolReader(BufferedReader sourceReader) { reader = sourceReader; state = new State(); @@ -66,7 +65,10 @@ CobolLine readLine() throws IOException { } previousLine = currentLine; setPreviousMeaningfulLine(); - currentLine = new CobolLine(line, tokenExtractor); + if (line.length() > 72) + currentLine = new CobolLine(line.substring(0, 72), tokenExtractor); + else + currentLine = new CobolLine(line, tokenExtractor); return currentLine; } diff --git a/src/main/java/org/openmainframeproject/cobolcheck/features/interpreter/InterpreterController.java b/src/main/java/org/openmainframeproject/cobolcheck/features/interpreter/InterpreterController.java index 79b390bc..2721879d 100644 --- a/src/main/java/org/openmainframeproject/cobolcheck/features/interpreter/InterpreterController.java +++ b/src/main/java/org/openmainframeproject/cobolcheck/features/interpreter/InterpreterController.java @@ -233,7 +233,10 @@ public String interpretNextLine() { } // Current line might change from when it was originally read - return reader.getCurrentLine().getUnNumberedString(); + if (reader.getCurrentLine().getUnNumberedString().length() > 72 ) + return reader.getCurrentLine().getUnNumberedString().substring(0, 72); + else + return reader.getCurrentLine().getUnNumberedString(); } public void closeReader() { diff --git a/src/test/java/org/openmainframeproject/cobolcheck/ExpanderTest.java b/src/test/java/org/openmainframeproject/cobolcheck/ExpanderTest.java index eec031ca..4d165f29 100644 --- a/src/test/java/org/openmainframeproject/cobolcheck/ExpanderTest.java +++ b/src/test/java/org/openmainframeproject/cobolcheck/ExpanderTest.java @@ -396,9 +396,6 @@ public void variable_before_exec_sql_include_is_evaluated_as_text() throws IOExc " . " + Constants.NEWLINE + " " + Constants.NEWLINE + " *CALL \"PROGRAM\" USING VALUE-1 " + Constants.NEWLINE + - " * ON EXCEPTION " + Constants.NEWLINE + - " * PERFORM 100-WELCOME " + Constants.NEWLINE + - " *END-CALL. " + Constants.NEWLINE + " PERFORM UT-PROCESS-UNMOCK-CALL " + Constants.NEWLINE + " CONTINUE " + Constants.NEWLINE + " . "; @@ -443,8 +440,6 @@ public void variable_before_exec_sql_include_is_evaluated_as_text() throws IOExc " . " + Constants.NEWLINE + " " + Constants.NEWLINE + " *CALL \"PROGRAM\" USING VALUE-1 " + Constants.NEWLINE + - " * ON EXCEPTION " + Constants.NEWLINE + - " * PERFORM 100-WELCOME. " + Constants.NEWLINE + " PERFORM UT-PROCESS-UNMOCK-CALL " + Constants.NEWLINE + " CONTINUE " + Constants.NEWLINE + " . "; @@ -489,8 +484,6 @@ public void variable_before_exec_sql_include_is_evaluated_as_text() throws IOExc " . " + Constants.NEWLINE + " " + Constants.NEWLINE + " *CALL \"PROGRAM\" USING VALUE-1 " + Constants.NEWLINE + - " * ON EXCEPTION " + Constants.NEWLINE + - " * DISPLAY \"HELLO WORLD\". " + Constants.NEWLINE + " PERFORM UT-PROCESS-UNMOCK-CALL " + Constants.NEWLINE + " CONTINUE " + Constants.NEWLINE + " . "; @@ -535,12 +528,6 @@ public void variable_before_exec_sql_include_is_evaluated_as_text() throws IOExc " . " + Constants.NEWLINE + " " + Constants.NEWLINE + " *CALL \"PROGRAM\" USING VALUE-1 " + Constants.NEWLINE + - " * ON EXCEPTION " + Constants.NEWLINE + - " * CALL \"PROGRAM2\" USING VALUE-1 " + Constants.NEWLINE + - " * ON EXCEPTION " + Constants.NEWLINE + - " * DISPLAY \"HELLO WORLD\" " + Constants.NEWLINE + - " * END-CALL " + Constants.NEWLINE + - " *END-CALL " + Constants.NEWLINE + " PERFORM UT-PROCESS-UNMOCK-CALL " + Constants.NEWLINE + " CONTINUE " + Constants.NEWLINE + " DISPLAY \"NO COMMENTS\" " + Constants.NEWLINE; @@ -585,12 +572,10 @@ public void variable_before_exec_sql_include_is_evaluated_as_text() throws IOExc " . " + Constants.NEWLINE + " " + Constants.NEWLINE + " *CALL \"PROGRAM\" USING DATA-1 ON EXCEPTION " + Constants.NEWLINE + - " * DISPLAY \"ERROR\". " + Constants.NEWLINE + " PERFORM UT-PROCESS-UNMOCK-CALL " + Constants.NEWLINE + " CONTINUE " + Constants.NEWLINE + " . " + Constants.NEWLINE + " *CALL \"PROGRAM\" USING DATA-1 ON EXCEPTION " + Constants.NEWLINE + - " * DISPLAY \"ERROR\". " + Constants.NEWLINE + " PERFORM UT-PROCESS-UNMOCK-CALL " + Constants.NEWLINE + " CONTINUE " + Constants.NEWLINE + " . " + Constants.NEWLINE; diff --git a/src/test/java/org/openmainframeproject/cobolcheck/InterpreterControllerTest.java b/src/test/java/org/openmainframeproject/cobolcheck/InterpreterControllerTest.java index 20dd88ce..2bdde089 100644 --- a/src/test/java/org/openmainframeproject/cobolcheck/InterpreterControllerTest.java +++ b/src/test/java/org/openmainframeproject/cobolcheck/InterpreterControllerTest.java @@ -1016,4 +1016,18 @@ public void it_stubs_linkage_line() throws IOException { } assertTrue(testsRan); } + + @Test + public void it_doesnt_read_pass_col_72() throws IOException { + String str1 = " THIS LINEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEE IS LONGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGG"; + + Mockito.when(mockedReader.readLine()).thenReturn(str1, null); + + while (interpreterController.interpretNextLine() != null){ + interpreterController.interpretNextLine(); + } + + assertEquals(interpreterController.getCurrentLineAsStatement().getTrimmedString(), "THIS LINEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEE IS LONGGGGGGGG"); + + } } diff --git a/vs-code-extension/Cobol-check/bin/cobol-check-0.2.8.jar b/vs-code-extension/Cobol-check/bin/cobol-check-0.2.8.jar index d9cbfa4a..3f6da6e2 100644 Binary files a/vs-code-extension/Cobol-check/bin/cobol-check-0.2.8.jar and b/vs-code-extension/Cobol-check/bin/cobol-check-0.2.8.jar differ