diff --git a/src/main/cobol/DB2PROG.cbl b/src/main/cobol/DB2PROG.cbl index 68ffb6b3..70028be3 100644 --- a/src/main/cobol/DB2PROG.cbl +++ b/src/main/cobol/DB2PROG.cbl @@ -20,7 +20,7 @@ DECLARE NAME-CUR CURSOR FOR SELECT FIRST_NAME, LAST_NAME FROM TEXEM END-EXEC. - + LINKAGE SECTION. PROCEDURE DIVISION. 0000-MAIN. 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 6b2ee2b4..0a4abf78 100644 --- a/src/main/java/org/openmainframeproject/cobolcheck/features/interpreter/InterpreterController.java +++ b/src/main/java/org/openmainframeproject/cobolcheck/features/interpreter/InterpreterController.java @@ -53,6 +53,10 @@ public List getFileControlStatements() { return lineRepository.getFileControlStatements(); } + public List getSqlCopyBookStatements() { + return lineRepository.getSqlCopyBookStatement(); + } + public Map getFileIdentifiersAndStatuses() { return lineRepository.getFileIdentifiersAndStatuses(); } @@ -154,9 +158,11 @@ public boolean shouldCurrentLineBeStubbed() throws IOException { public boolean shouldCurrentStatementBeStubbed() { for (CobolLine line : reader.getCurrentStatement()) { if (Interpreter.shouldLineBeStubbed(line, reader.getState())) { - if (!insideSectionOrParagraphMockBody && Interpreter.endsInPeriod(reader.getCurrentLine())) + if (!insideSectionOrParagraphMockBody && Interpreter.endsInPeriod(reader.getCurrentLine())) { reader.putNextLine(" ."); - reader.putNextLine(" CONTINUE"); + if (!reader.getState().isFlagSetFor(Constants.WORKING_STORAGE_SECTION)) + reader.putNextLine(" CONTINUE"); + } return true; } } diff --git a/src/main/java/org/openmainframeproject/cobolcheck/features/interpreter/LineRepository.java b/src/main/java/org/openmainframeproject/cobolcheck/features/interpreter/LineRepository.java index 6f332ab3..b51b4834 100644 --- a/src/main/java/org/openmainframeproject/cobolcheck/features/interpreter/LineRepository.java +++ b/src/main/java/org/openmainframeproject/cobolcheck/features/interpreter/LineRepository.java @@ -24,6 +24,9 @@ public class LineRepository { // All lines from original Data Division / File Section private List fileSectionStatements; + // All lines from DB2 Copybooks + private List sqlCopyBookStatement; + // Internal file identifiers and status field names private final Map fileIdentifiersAndStatuses; @@ -32,6 +35,7 @@ public class LineRepository { LineRepository() { fileSectionStatements = new ArrayList<>(); + sqlCopyBookStatement = new ArrayList<>(); this.fileIdentifiersAndStatuses = new HashMap<>(); } @@ -43,6 +47,10 @@ List getFileSectionStatements() { return fileSectionStatements; } + List getSqlCopyBookStatement() { + return sqlCopyBookStatement; + } + Map getFileIdentifiersAndStatuses() { return fileIdentifiersAndStatuses; } @@ -67,14 +75,23 @@ void addFileSectionStatement(String statement){ } fileSectionStatements.add(statement); } + + void addsqlCopyBookStatement(String statement){ + if (sqlCopyBookStatement == null){ + sqlCopyBookStatement = new ArrayList<>(); + } + sqlCopyBookStatement.add(statement); + } void putFileIdentifierAndStatus(String key, String value){ fileIdentifiersAndStatuses.put(key, value); } + void addFileIdentifierWithNoStatus(String identifier){ fileIdentifiersAndStatuses.put(identifier, Constants.EMPTY_STRING); currentExpectFileIdentifier = identifier; } + void addStatusForLastSetIdentifier(String status){ fileIdentifiersAndStatuses.put(currentExpectFileIdentifier, status); } @@ -144,7 +161,7 @@ List addExpandedCopyDB2Statements(CobolLine line) throws IOException { } catch (IOException ioEx) { throw new CopybookCouldNotBeExpanded(ioEx); } - fileSectionStatements.addAll(copyLines); + sqlCopyBookStatement.addAll(copyLines); return copyLines; } } diff --git a/src/main/java/org/openmainframeproject/cobolcheck/workers/Generator.java b/src/main/java/org/openmainframeproject/cobolcheck/workers/Generator.java index d7bd7d13..706a60d2 100644 --- a/src/main/java/org/openmainframeproject/cobolcheck/workers/Generator.java +++ b/src/main/java/org/openmainframeproject/cobolcheck/workers/Generator.java @@ -33,6 +33,7 @@ public class Generator { private WriterController writerController; private TestSuiteParserController testSuiteParserController; private boolean workingStorageHasEnded; + private boolean linkageExist; List matchingTestDirectories; @@ -82,7 +83,8 @@ public void prepareAndRunMerge(String programName, String testFileNames) { Log.debug("Initializer.runTestSuites() testSourceOutPath: <" + testSourceOutPath + ">"); workingStorageHasEnded = false; - + linkageExist = false; + mergeTestSuite(); Log.info(Messages.get("INF012", programName)); @@ -132,12 +134,19 @@ private void processingBeforeEchoingSourceLineToOutput() throws IOException { writerController.startStoringLines(); workingStorageHasEnded = true; } - if (interpreter.didLineJustEnter(Constants.PROCEDURE_DIVISION) && interpreter.currentLineContains(Constants.PROCEDURE_DIVISION)){ + if (interpreter.didLineJustEnter(Constants.PROCEDURE_DIVISION) && interpreter.currentLineContains(Constants.PROCEDURE_DIVISION)) { + if (!interpreter.getSqlCopyBookStatements().isEmpty() && !linkageExist) + writerController.writeLines(interpreter.getSqlCopyBookStatements()); writerController.stopStoringLines(); testSuiteParserController.parseTestSuites(interpreter.getNumericFields()); writerController.writeLines(testSuiteParserController.getWorkingStorageMockCode()); writerController.releaseStoredLines(); } + if (interpreter.didLineJustEnter(Constants.LINKAGE_SECTION)) { + if (!interpreter.getSqlCopyBookStatements().isEmpty() ) + writerController.writeLines(interpreter.getSqlCopyBookStatements()); + linkageExist = true; + } } private String tryInsertEndEvaluateAtMockedCompomentEnd(String sourceLine) throws IOException { @@ -177,8 +186,6 @@ private void writeToSource(String sourceLine) throws IOException { if (interpreter.shouldCurrentLineBeStubbed()) { if(interpreter.isReading(Constants.WORKING_STORAGE_SECTION)) { writerController.writeStubbedLine(interpreter.getCurrentLineAsStatement().getUnNumberedString()); - if (!interpreter.getFileSectionStatements().isEmpty()) - writerController.writeLines(interpreter.getFileSectionStatements()); } else writerController.writeStubbedLine(sourceLine); diff --git a/src/test/java/org/openmainframeproject/cobolcheck/ExpanderTest.java b/src/test/java/org/openmainframeproject/cobolcheck/ExpanderTest.java index 0d356fae..5636ccb7 100644 --- a/src/test/java/org/openmainframeproject/cobolcheck/ExpanderTest.java +++ b/src/test/java/org/openmainframeproject/cobolcheck/ExpanderTest.java @@ -90,9 +90,36 @@ public void it_inserts_a_mock_correctly() throws IOException { List actual = Utilities.getTrimmedList(Utilities.removeBoilerPlateCode(writer.toString(), boilerPlateTags)); - assertEquals(Utilities.getTrimmedList(expected1), actual); + assertEquals(Utilities.getTrimmedList(expected0), actual); } + @Test + public void it_inserts_db2_copy_linkage_correctly() throws IOException { + String s1 = " WORKING-STORAGE SECTION."; + String s2 = " EXEC SQL INCLUDE TEXEM END-EXEC."; + String s3 = " 01 FILLER."; + String s4 = " 05 WS-FIELD-1 PIC X(80)."; + String s5 = " 05 ws-Field-2 PIC X(80)."; + String s6 = " LINKAGE SECTION."; + String s7 = " PROCEDURE DIVISION."; + String s8 = " 000-START SECTION."; + String s9 = " MOVE \"Value1\" to WS-FIELD-1"; + String s10 = " EXIT SECTION"; + String s11 = " ."; + + String t1 = " TestSuite \"Basic test\""; + String t2 = " PERFORM 000-START"; + String t3 = " EXPECT WS-FIELD-1 TO BE \"Value1\""; + + Mockito.when(mockedInterpreterReader.readLine()).thenReturn(s1, s2, s3, s4, s5, s6, s7, s8, s9, s10, s11, null); + Mockito.when(mockedParserReader.readLine()).thenReturn(t1, t2, t3, null); + + generator = new Generator(interpreterController, writerController, testSuiteParserController); + + List actual = Utilities.getTrimmedList(Utilities.removeBoilerPlateCode(writer.toString(), boilerPlateTags)); + + assertEquals(Utilities.getTrimmedList(expected1), actual); + } @Test public void it_inserts_code_correctly_when_call_has_exception_handling_with_end_call_terminator() @@ -264,17 +291,78 @@ public void it_inserts_code_correctly_when_there_are_some_unmock_calls_and_confi assertEquals(Utilities.getTrimmedList(expected8), actual); Config.changeProperty("cobolcheck.test.unmockcall.display", "true"); } - - private String expected1 = +private String expected0 = " WORKING-STORAGE SECTION. " + Constants.NEWLINE + " *EXEC SQL INCLUDE TEXEM END-EXEC. " + Constants.NEWLINE + + " 01 FILLER. " + Constants.NEWLINE + + " 05 WS-FIELD-1 PIC X(80). " + Constants.NEWLINE + + " 05 ws-Field-2 PIC X(80). " + Constants.NEWLINE + " 01 TEXEM. " + Constants.NEWLINE + " 10 FIRST-NAME PIC X(10). " + Constants.NEWLINE + " 10 LAST-NAME PIC X(10). " + Constants.NEWLINE + " 10 TMS-CREA PIC X(26). " + Constants.NEWLINE + + " PROCEDURE DIVISION. " + Constants.NEWLINE + + " PERFORM UT-INITIALIZE " + Constants.NEWLINE + + " *============= \"Basic test\" =============* " + Constants.NEWLINE + + " DISPLAY \"TESTSUITE:\" " + Constants.NEWLINE + + " DISPLAY \"Basic test\" " + Constants.NEWLINE + + " MOVE \"Basic test\" " + Constants.NEWLINE + + " TO UT-TEST-SUITE-NAME " + Constants.NEWLINE + + " PERFORM 000-START " + Constants.NEWLINE + + " ADD 1 TO UT-TEST-CASE-COUNT " + Constants.NEWLINE + + " SET UT-NORMAL-COMPARE TO TRUE " + Constants.NEWLINE + + " SET UT-ALPHANUMERIC-COMPARE TO TRUE " + Constants.NEWLINE + + " MOVE WS-FIELD-1 TO UT-ACTUAL " + Constants.NEWLINE + + " MOVE \"Value1\" " + Constants.NEWLINE + + " TO UT-EXPECTED " + Constants.NEWLINE + + " SET UT-RELATION-EQ TO TRUE " + Constants.NEWLINE + + " PERFORM UT-CHECK-EXPECTATION " + Constants.NEWLINE + + " UT-BEFORE-EACH. " + Constants.NEWLINE + + " ***************************************************************** " + Constants.NEWLINE + + " *This is performed before each Test Case " + Constants.NEWLINE + + " ***************************************************************** " + Constants.NEWLINE + + " CONTINUE " + Constants.NEWLINE + + " . " + Constants.NEWLINE + + " " + Constants.NEWLINE + + " UT-AFTER-EACH. " + Constants.NEWLINE + + " ***************************************************************** " + Constants.NEWLINE + + " *This is performed after each Test Case " + Constants.NEWLINE + + " ***************************************************************** " + Constants.NEWLINE + + " CONTINUE " + Constants.NEWLINE + + " . " + Constants.NEWLINE + + " " + Constants.NEWLINE + + " PROCESS-UNMOCK-CALL. " + Constants.NEWLINE + + " Add 1 to UT-NUMBER-UNMOCK-CALL " + Constants.NEWLINE + + " display \"Call not mocked in testcase \" UT-TEST-CASE-NAME \" in " + Constants.NEWLINE + + " - \" testsuite \" UT-TEST-SUITE-NAME " + Constants.NEWLINE + + " display \"All used calls should be mocked, to ensure the unit " + Constants.NEWLINE + + " - \"test has control over input data\" " + Constants.NEWLINE + + " CONTINUE " + Constants.NEWLINE + + " . " + Constants.NEWLINE + + " " + Constants.NEWLINE + + " UT-INITIALIZE-MOCK-COUNT. " + Constants.NEWLINE + + " ***************************************************************** " + Constants.NEWLINE + + " *Sets all global mock counters and expected count to 0 " + Constants.NEWLINE + + " ***************************************************************** " + Constants.NEWLINE + + " CONTINUE " + Constants.NEWLINE + + " . " + Constants.NEWLINE + + " " + Constants.NEWLINE + + " 000-START SECTION. " + Constants.NEWLINE + + " MOVE \"Value1\" to WS-FIELD-1 " + Constants.NEWLINE + + " EXIT SECTION " + Constants.NEWLINE + + " . "; + + private String expected1 = + " WORKING-STORAGE SECTION. " + Constants.NEWLINE + + " *EXEC SQL INCLUDE TEXEM END-EXEC. " + Constants.NEWLINE + " 01 FILLER. " + Constants.NEWLINE + " 05 WS-FIELD-1 PIC X(80). " + Constants.NEWLINE + " 05 ws-Field-2 PIC X(80). " + Constants.NEWLINE + + " 01 TEXEM. " + Constants.NEWLINE + + " 10 FIRST-NAME PIC X(10). " + Constants.NEWLINE + + " 10 LAST-NAME PIC X(10). " + Constants.NEWLINE + + " 10 TMS-CREA PIC X(26). " + Constants.NEWLINE + + " LINKAGE SECTION. " + Constants.NEWLINE + " PROCEDURE DIVISION. " + Constants.NEWLINE + " PERFORM UT-INITIALIZE " + Constants.NEWLINE + " *============= \"Basic test\" =============* " + Constants.NEWLINE + diff --git a/src/test/java/org/openmainframeproject/cobolcheck/InterpreterControllerTest.java b/src/test/java/org/openmainframeproject/cobolcheck/InterpreterControllerTest.java index 20dd88ce..b2330cf3 100644 --- a/src/test/java/org/openmainframeproject/cobolcheck/InterpreterControllerTest.java +++ b/src/test/java/org/openmainframeproject/cobolcheck/InterpreterControllerTest.java @@ -890,11 +890,11 @@ public void it_adds_file_section_statements_from_source_and_db2copybook_multiple interpreterController.interpretNextLine(); } - assertEquals(4,interpreterController.getFileSectionStatements().size()); - assertTrue(interpreterController.getFileSectionStatements().contains(" 01 TEXEM.")); - assertTrue(interpreterController.getFileSectionStatements().contains(" 10 FIRST-NAME PIC X(10).")); - assertTrue(interpreterController.getFileSectionStatements().contains(" 10 LAST-NAME PIC X(10).")); - assertTrue(interpreterController.getFileSectionStatements().contains(" 10 TMS-CREA PIC X(26).")); + assertEquals(4,interpreterController.getSqlCopyBookStatements().size()); + assertTrue(interpreterController.getSqlCopyBookStatements().contains(" 01 TEXEM.")); + assertTrue(interpreterController.getSqlCopyBookStatements().contains(" 10 FIRST-NAME PIC X(10).")); + assertTrue(interpreterController.getSqlCopyBookStatements().contains(" 10 LAST-NAME PIC X(10).")); + assertTrue(interpreterController.getSqlCopyBookStatements().contains(" 10 TMS-CREA PIC X(26).")); } @Test @@ -910,11 +910,11 @@ public void it_adds_file_section_statements_from_source_and_db2copybook() throws interpreterController.interpretNextLine(); } - assertEquals(4,interpreterController.getFileSectionStatements().size()); - assertTrue(interpreterController.getFileSectionStatements().contains(" 01 TEXEM.")); - assertTrue(interpreterController.getFileSectionStatements().contains(" 10 FIRST-NAME PIC X(10).")); - assertTrue(interpreterController.getFileSectionStatements().contains(" 10 LAST-NAME PIC X(10).")); - assertTrue(interpreterController.getFileSectionStatements().contains(" 10 TMS-CREA PIC X(26).")); + assertEquals(4,interpreterController.getSqlCopyBookStatements().size()); + assertTrue(interpreterController.getSqlCopyBookStatements().contains(" 01 TEXEM.")); + assertTrue(interpreterController.getSqlCopyBookStatements().contains(" 10 FIRST-NAME PIC X(10).")); + assertTrue(interpreterController.getSqlCopyBookStatements().contains(" 10 LAST-NAME PIC X(10).")); + assertTrue(interpreterController.getSqlCopyBookStatements().contains(" 10 TMS-CREA PIC X(26).")); } @Test