diff --git a/CHANGELOG.md b/CHANGELOG.md index 2214ce35..db9226e2 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -20,6 +20,9 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Mock SQL tables - Mock batch file I/O +## \[0.2.18\] 2025-06-02 +- Sequence numbers are handled correct in long lines + ## \[0.2.17\] 2025-04-02 - Made sure we are using the correct encoding diff --git a/approvaltestWin.cmd b/approvaltestWin.cmd index 22fba940..0a829e35 100644 --- a/approvaltestWin.cmd +++ b/approvaltestWin.cmd @@ -1 +1 @@ -./cobolcheck -p ALPHA DB2PROG DPICNUMBERS FILECOPY GREETING MOCK MOCKPARA MOCKTEST NUMBERS RETURNCODE TESTNESTED > approval-test-actual.txt \ No newline at end of file +./cobolcheck -p ALPHA DB2PROG DPICNUMBERS FILECOPY GREETING MOCK MOCKPARA MOCKTEST NUMBERS RETURNCODE TESTNESTED LONGLINESANDNUMBERS > approval-test-actual.txt \ No newline at end of file diff --git a/build.gradle b/build.gradle index 5561c538..aef457b5 100644 --- a/build.gradle +++ b/build.gradle @@ -6,7 +6,7 @@ plugins { id 'jacoco' } -def productVersion = '0.2.17' +def productVersion = '0.2.18' def productName = 'cobol-check' group = 'org.openmainframeproject' description = 'Unit testing framework for Cobol' diff --git a/build/distributions/cobol-check-0.2.18.zip b/build/distributions/cobol-check-0.2.18.zip new file mode 100644 index 00000000..ea5d17cf Binary files /dev/null and b/build/distributions/cobol-check-0.2.18.zip differ diff --git a/src/main/cobol/LONGLINESANDNUMBERS.CBL b/src/main/cobol/LONGLINESANDNUMBERS.CBL new file mode 100644 index 00000000..c2f74695 --- /dev/null +++ b/src/main/cobol/LONGLINESANDNUMBERS.CBL @@ -0,0 +1,65 @@ +000100 IDENTIFICATION DIVISION. +000200 PROGRAM-ID. GREETING. +000300***************************************************************** +000400* Trivial program to exercise CobolCheck. +000500***************************************************************** +000600 ENVIRONMENT DIVISION. +000700 INPUT-OUTPUT SECTION. +000800 FILE-CONTROL. +000900 DATA DIVISION. +001000 WORKING-STORAGE SECTION. +001100 01 FILLER. +001200 05 WS-COUNT PIC S9(5) COMP-3. +001300 05 FILLER PIC X VALUE 'G'. +001400 88 MESSAGE-IS-GREETING VALUE 'G'. +001500 88 MESSAGE-IS-FAREWELL VALUE 'F'. +001600 88 MESSAGE-IS-FAREWELL-LONG VALUE 'L'. +001700 01 WS-FRIEND PIC X(10) VALUE SPACES. +001800 01 WS-GREETING. +001900 10 FILLER PIC X(07) VALUE 'Hello, '. +002000 10 WS-USER-NAME PIC X(05) VALUE SPACES. +002100 10 FILLER PIC X VALUE '!'. +002200 01 WS-FAREWELL. +002300 10 FILLER PIC X(15) VALUE 'See you later, '. +002400 10 WS-USER-NAME PIC X(09) VALUE SPACES. +002500 10 FILLER PIC X VALUE '!'. +002600 01 WS-FAREWELL-LONG. +002700 10 FILLER PIC X(15) VALUE 'See you later, '. +002800 10 WS-USER-NAME-LONG PIC X(19) VALUE SPACES. +002900 10 FILLER PIC X VALUE '!'. +003000 REPLACE +003100 ==:TEXT:== BY =="ReallylongAlligator"==. +003200 +003300 PROCEDURE DIVISION. +003400 +003500 ACCEPT WS-FRIEND. +003600 +003700 2000-SPEAK. +003800 IF MESSAGE-IS-GREETING +003900 IF WS-FRIEND EQUAL SPACES +004000 MOVE 'World' TO WS-USER-NAME OF WS-GREETING +004100 ELSE +004200 MOVE WS-FRIEND TO WS-USER-NAME OF WS-GREETING +004300 END-IF +004400 END-IF +004500 IF MESSAGE-IS-FAREWELL +004600 IF WS-FRIEND EQUAL SPACES +004700 MOVE 'alligator!' TO WS-USER-NAME OF WS-FAREWELL +004800 ELSE +004900 MOVE WS-FRIEND TO WS-USER-NAME OF WS-FAREWELL +005000 END-IF +005100 END-IF +005200 IF MESSAGE-IS-FAREWELL-LONG +005300 IF WS-FRIEND EQUAL SPACES +005400 MOVE :TEXT: TO WS-USER-NAME-LONG OF WS-FAREWELL-LONG +005500 ELSE +005600 MOVE WS-FRIEND TO WS-USER-NAME-LONG +005700 OF WS-FAREWELL-LONG +005800 END-IF +005900 END-IF +006000 . +006100 +006200 9999-END. +006300 CONTINUE +006400 . +006500 \ No newline at end of file diff --git a/src/main/java/org/openmainframeproject/cobolcheck/features/writer/CobolWriter.java b/src/main/java/org/openmainframeproject/cobolcheck/features/writer/CobolWriter.java index 0ab9ef88..ea728a5b 100644 --- a/src/main/java/org/openmainframeproject/cobolcheck/features/writer/CobolWriter.java +++ b/src/main/java/org/openmainframeproject/cobolcheck/features/writer/CobolWriter.java @@ -160,6 +160,11 @@ void close() throws IOException { * @throws IOException - pass any IOExceptions to the caller. */ private void writeMultiLine(String line, boolean isComment, boolean isRecursiveCall) throws IOException { + String saveNumbers = ""; + if (line.matches("^\\d{6}.*")) { + saveNumbers = line.substring(0,6); + line = line.replaceFirst("^\\d{6}", " "); + } String line1 = line.substring(0,maxLineLength); String line2 = line.substring(maxLineLength); if (line2.length() > 0 && !isComment) { @@ -197,6 +202,9 @@ else if (isRecursiveCall) } } } + if (!saveNumbers.isEmpty()) { + line1 = line1.replaceFirst(" ", saveNumbers); + } writeLine(line1); } else if (line2.length() > 0 && isComment){ diff --git a/src/main/java/org/openmainframeproject/cobolcheck/workers/Initializer.java b/src/main/java/org/openmainframeproject/cobolcheck/workers/Initializer.java index 293c51cf..f075724b 100644 --- a/src/main/java/org/openmainframeproject/cobolcheck/workers/Initializer.java +++ b/src/main/java/org/openmainframeproject/cobolcheck/workers/Initializer.java @@ -21,7 +21,7 @@ public class Initializer { private StatusController statusController; public Initializer(String[] args) { - Log.info(Messages.get("INF000", "0.2.17")); + Log.info(Messages.get("INF000", "0.2.18")); argumentController = new ArgumentHandlerController(args); environmentController = new EnvironmentSetupController(); statusController = new StatusController(); diff --git a/src/test/cobol/LONGLINESANDNUMBERS/GreetingByNameLongLineAndNumbers.cut b/src/test/cobol/LONGLINESANDNUMBERS/GreetingByNameLongLineAndNumbers.cut new file mode 100644 index 00000000..f1a569f7 --- /dev/null +++ b/src/test/cobol/LONGLINESANDNUMBERS/GreetingByNameLongLineAndNumbers.cut @@ -0,0 +1,20 @@ + TESTSUITE + "Greeting includes the user name when it is provided" + + TESTCASE "When message type is greeting it returns Hello, James!" + SET MESSAGE-IS-GREETING TO TRUE + MOVE "James" TO WS-FRIEND + PERFORM 2000-SPEAK + EXPECT WS-GREETING TO BE "Hello, James!" + + TESTCASE "When message type is farewell it returns Goodbye, James !" + SET MESSAGE-IS-FAREWELL TO TRUE + MOVE "James" TO WS-FRIEND + PERFORM 2000-SPEAK + EXPECT WS-FAREWELL TO BE "See you later, James !" + + TESTCASE "User name for greeting and farewell are consistent" + SET MESSAGE-IS-GREETING TO TRUE + Move "Henry" TO WS-FRIEND + PERFORM 2000-SPEAK + EXPECT WS-USER-NAME OF WS-GREETING TO BE "Henry" diff --git a/src/test/cobol/LONGLINESANDNUMBERS/GreetingByTypeLongLineAndNumbers.cut b/src/test/cobol/LONGLINESANDNUMBERS/GreetingByTypeLongLineAndNumbers.cut new file mode 100644 index 00000000..a5828f70 --- /dev/null +++ b/src/test/cobol/LONGLINESANDNUMBERS/GreetingByTypeLongLineAndNumbers.cut @@ -0,0 +1,26 @@ + TESTSUITE + "Greeting returns the appropriate message based on message type" + + TestCase "When message type is greeting it returns 'Hello, World!'" + move space to WS-FRIEND + SET MESSAGE-IS-GREETING TO TRUE + PERFORM 2000-SPEAK + EXPECT WS-GREETING TO BE "Hello, World!" + + TESTCASE "try numerical compare" + ADD 1 TO WS-COUNT + EXPECT WS-COUNT TO BE 1 + + TESTCASE "try 88 level compare" + set message-is-farewell to true + EXPECT MESSAGE-IS-GREETING TO BE FALSE + + TESTCASE "When message type is farewell it returns See you later, alligator!" + SET MESSAGE-IS-FAREWELL-LONG TO TRUE + PERFORM 2000-SPEAK + Expect WS-FAREWELL-LONG To Be "See you later, ReallylongAlligator!" + + TESTCASE "Message type greeting is not true" + SET MESSAGE-IS-FAREWELL TO TRUE + Expect MESSAGE-IS-GREETING NOT TO BE TRUE + diff --git a/vs-code-extension/CHANGELOG.md b/vs-code-extension/CHANGELOG.md index 4b87d578..32de2f8b 100644 --- a/vs-code-extension/CHANGELOG.md +++ b/vs-code-extension/CHANGELOG.md @@ -2,6 +2,9 @@ All notable changes to the "cobol-unit-test" extension will be documented in this file. Versioning according to SemVer: https://semver.org/ +## [0.4.12] 02.06.2025 +- Now using COBOL Check version 0.2.18 + ## [0.4.11] 02.04.2025 - Now using COBOL Check version 0.2.17 diff --git a/vs-code-extension/Cobol-check/bin/cobol-check-0.2.16.jar b/vs-code-extension/Cobol-check/bin/cobol-check-0.2.16.jar deleted file mode 100644 index ffb8d0b7..00000000 Binary files a/vs-code-extension/Cobol-check/bin/cobol-check-0.2.16.jar and /dev/null differ diff --git a/vs-code-extension/Cobol-check/bin/cobol-check-0.2.17.jar b/vs-code-extension/Cobol-check/bin/cobol-check-0.2.18.jar similarity index 89% rename from vs-code-extension/Cobol-check/bin/cobol-check-0.2.17.jar rename to vs-code-extension/Cobol-check/bin/cobol-check-0.2.18.jar index de7a4353..e9423eb1 100644 Binary files a/vs-code-extension/Cobol-check/bin/cobol-check-0.2.17.jar and b/vs-code-extension/Cobol-check/bin/cobol-check-0.2.18.jar differ diff --git a/vs-code-extension/Cobol-check/src/main/cobol/ALPHA.CBL b/vs-code-extension/Cobol-check/src/main/cobol/ALPHA.CBL index ffbe76ad..e552b0cb 100644 --- a/vs-code-extension/Cobol-check/src/main/cobol/ALPHA.CBL +++ b/vs-code-extension/Cobol-check/src/main/cobol/ALPHA.CBL @@ -24,3 +24,4 @@ 05 ws-display-numeric pic 999. PROCEDURE DIVISION. GOBACK. + \ No newline at end of file diff --git a/vs-code-extension/Cobol-check/src/main/cobol/NUMBERS.CBL b/vs-code-extension/Cobol-check/src/main/cobol/NUMBERS.CBL index 913476f1..ecd4d750 100644 --- a/vs-code-extension/Cobol-check/src/main/cobol/NUMBERS.CBL +++ b/vs-code-extension/Cobol-check/src/main/cobol/NUMBERS.CBL @@ -14,5 +14,8 @@ 05 ws-field-3 pic s9(16) comp. 05 ws-field-4 pic s9(16) comp-4. 05 ws-display-field pic s9(5)v99. + 05 ws-num-occ pic 9(04) occurs 10. + 77 CHAR-CT PIC S9(3) COMP. PROCEDURE DIVISION. GOBACK. + \ No newline at end of file diff --git a/vs-code-extension/Cobol-check/src/test/cobol/ALPHA/AlphaExpectationsTest.cut b/vs-code-extension/Cobol-check/src/test/cobol/ALPHA/AlphaExpectationsTest.cut index 8074bb50..2b40dfe9 100644 --- a/vs-code-extension/Cobol-check/src/test/cobol/ALPHA/AlphaExpectationsTest.cut +++ b/vs-code-extension/Cobol-check/src/test/cobol/ALPHA/AlphaExpectationsTest.cut @@ -1,61 +1,66 @@ TestSuite "Tests of alphanumeric expectations" - + TestCase "Equality with an alphanumeric literal using TO BE" move "value1" to ws-field-1 Expect ws-field-1 to be "value1" - + TestCase "Equality with an alphanumeric literal using TO EQUAL" move "value2" to ws-field-1 Expect ws-field-1 to equal "value2" - + TestCase "Equality with an alphanumeric literal using '='" move "value3" to ws-field-1 Expect ws-field-1 = "value3" - + TestCase "Equality with an alphanumeric literal and reference modification" move "Hello, World!" to ws-field-2 Expect ws-field-2(8:5) to be "World" - + TestCase "Non-equality with an alphanumeric literal using TO BE" move "value4" to ws-field-1 Expect ws-field-1 not to be "value1" - + TestCase "Non-equality with an alphanumeric literal using TO EQUAL" move "value5" to ws-field-1 Expect ws-field-1 not to equal "value1" - + TestCase "Non-equality with an alphanumeric literal using '!='" move "value6" to ws-field-1 Expect ws-field-1 != "value1" - + TestCase "Non-equality with an alphanumeric literal and reference modification" move "Hello, World!" to ws-field-2 Expect ws-field-2(8:6) not to be "World" - + TestCase "Greater-than sign with an alphanumeric literal" move "Beta" to ws-field-1 move "Alpha" to ws-field-2 - Expect ws-field-1 > ws-field-2 - + Expect ws-field-1 > "Alpha" + TestCase "Less-than sign with an alphanumeric literal" move "Beta" to ws-field-1 move "Alpha" to ws-field-2 - Expect ws-field-2 < ws-field-1 - + Expect ws-field-2 < "Beta" + TestCase "Not greater-than sign with an alphanumeric literal" move "Beta" to ws-field-1 move "Alpha" to ws-field-2 - Expect ws-field-2 not > ws-field-1 - + Expect ws-field-2 not > "Beta" + TestCase "Not less-than sign with an alphanumeric literal" move "Beta" to ws-field-1 move "Alpha" to ws-field-2 - Expect ws-field-1 not < ws-field-2 - + Expect ws-field-1 not < "Alpha" + TestCase "Display numeric" move 6 to ws-display-numeric expect ws-display-numeric to be 6 - - - - + + TestCase "Variable must be SPACE" + move space to ws-field-1 + expect ws-field-1 to be space + + TestCase "Variable must be SPACES" + move spaces to ws-field-1 + expect ws-field-1 to be spaces + \ No newline at end of file diff --git a/vs-code-extension/Cobol-check/src/test/cobol/NUMBERS/SymbolicRelationsTest.cut b/vs-code-extension/Cobol-check/src/test/cobol/NUMBERS/SymbolicRelationsTest.cut index 593f1fcd..a362bac2 100644 --- a/vs-code-extension/Cobol-check/src/test/cobol/NUMBERS/SymbolicRelationsTest.cut +++ b/vs-code-extension/Cobol-check/src/test/cobol/NUMBERS/SymbolicRelationsTest.cut @@ -38,43 +38,35 @@ TestCase "Equal sign with ield compare" Move 25.74 to WS-FIELD-1 - Move 25.74 to WS-FIELD-2 - Expect WS-FIELD-1 = WS-FIELD-2 + Expect WS-FIELD-1 = 25.74 TestCase "Equal sign with field compare (should fail)" Move 25.74 to WS-FIELD-1 - Move 25.75 to WS-FIELD-2 - Expect WS-FIELD-1 = WS-FIELD-2 + Expect WS-FIELD-1 = 25.75 TestCase "Not equal sign with field compare" Move 25.74 to WS-FIELD-1 - Move 25.75 to WS-FIELD-2 - Expect WS-FIELD-1 not = WS-FIELD-2 + Expect WS-FIELD-1 not = 25.75 TestCase "Not equal sign with field compare (should fail)" Move 25.74 to WS-FIELD-1 - Move 25.74 to WS-FIELD-2 - Expect WS-FIELD-1 not = WS-FIELD-2 + Expect WS-FIELD-1 not = 25.74 TestCase "Not-equal sign with field compare" Move 25.74 to WS-FIELD-1 - Move 25.75 to WS-FIELD-2 - Expect WS-FIELD-1 != WS-FIELD-2 + Expect WS-FIELD-1 != 25.75 TestCase "Not-equal sign with field compare (should fail)" Move 25.74 to WS-FIELD-1 - Move 25.74 to WS-FIELD-2 - Expect WS-FIELD-1 != WS-FIELD-2 + Expect WS-FIELD-1 != 25.74 TestCase "Not not-equal sign with field compare" Move 25.74 to WS-FIELD-1 - Move 25.74 to WS-FIELD-2 - Expect WS-FIELD-1 NOT != WS-FIELD-2 + Expect WS-FIELD-1 NOT != 25.74 TestCase "Not not-equal sign with field compare (should fail)" Move 25.75 to WS-FIELD-1 - Move 25.74 to WS-FIELD-2 - Expect WS-FIELD-1 not != WS-FIELD-2 + Expect WS-FIELD-1 not != 25.74 TestCase "Less-than sign with literal compare" Move 18.067 to WS-FIELD-1 @@ -94,23 +86,19 @@ TestCase "Less-than sign with field compare" Move 416.071 to WS-FIELD-1 - Move 416.072 to WS-FIELD-2 - Expect WS-FIELD-1 < WS-FIELD-2 + Expect WS-FIELD-1 < 416.072 TestCase "Less-than sign with field compare (should fail)" Move 416.072 to WS-FIELD-1 - Move 416.072 to WS-FIELD-2 - Expect WS-FIELD-1 < WS-FIELD-2 + Expect WS-FIELD-1 < 416.072 TestCase "Not less-than sign with field compare" Move 416.072 to WS-FIELD-1 - Move 416.071 to WS-FIELD-2 - Expect WS-FIELD-1 not < WS-FIELD-2 + Expect WS-FIELD-1 not < 416.071 TestCase "Not less-than sign with field compare (should fail)" Move 416.071 to WS-FIELD-1 - Move 416.072 to WS-FIELD-2 - Expect WS-FIELD-1 not < WS-FIELD-2 + Expect WS-FIELD-1 not < 416.072 TestCase "Greater-than sign with literal compare" Move 18.067 to WS-FIELD-1 @@ -122,33 +110,27 @@ TestCase "Not greater-than sign with literal compare" move 107.701 to ws-field-1 - move 107.701 to ws-field-2 - expect ws-field-1 not > ws-field-2 + expect ws-field-1 not > 107.701 TestCase "Not greater-than sign with literal compare (should fail)" move 107.702 to ws-field-1 - move 107.701 to ws-field-2 - expect ws-field-1 not > ws-field-2 + expect ws-field-1 not > 107.701 TestCase "Greater-than sign with field compare" Move 1766.03145 to WS-FIELD-1 - Move 1766.03144 to WS-FIELD-2 - Expect WS-FIELD-1 > WS-FIELD-2 + Expect WS-FIELD-1 > 1766.03144 TestCase "Greater-than sign with field compare (should fail)" Move 1766.03143 to WS-FIELD-1 - Move 1766.03144 to WS-FIELD-2 - Expect WS-FIELD-1 > WS-FIELD-2 + Expect WS-FIELD-1 > 1766.03144 TestCase "Not greater-than sign with field to field compare" Move 1766.03144 to WS-FIELD-1 - Move 1766.03144 to WS-FIELD-2 - Expect WS-FIELD-1 Not > WS-FIELD-2 + Expect WS-FIELD-1 Not > 1766.03144 TestCase "Not greater-than sign with field compare (should fail)" Move 1766.03145 to WS-FIELD-1 - Move 1766.03144 to WS-FIELD-2 - Expect WS-FIELD-1 NOT > WS-FIELD-2 + Expect WS-FIELD-1 NOT > 1766.03144 TestCase "Greater-than-or-equal-to sign with literal compare when greater" Move 18.067 to WS-FIELD-1 @@ -176,71 +158,88 @@ TestCase "Greater-than-or-equal-to-sign with field compare when equal" move 475.062 to ws-field-1 - move 475.062 to ws-field-2 - expect ws-field-1 >= ws-field-2 + expect ws-field-1 >= 475.062 TestCase "Greater-than-or-equal-to-sign with field compare when greater" move 475.063 to ws-field-1 - move 475.062 to ws-field-2 - expect ws-field-1 >= ws-field-2 + expect ws-field-1 >= 475.062 TestCase "Greater-than-or-equal-to-sign with field compare when less (should fail)" move 475.061 to ws-field-1 - move 475.062 to ws-field-2 - expect ws-field-1 >= ws-field-2 + expect ws-field-1 >= 475.062 TestCase "Not greater-than-or-equal-to-sign with field compare when less" move 475.062 to ws-field-1 - move 475.063 to ws-field-2 - expect ws-field-1 not >= ws-field-2 + expect ws-field-1 not >= 475.063 TestCase "Not greater-than-or-equal-to-sign with field compare when equal (should fail)" move 475.062 to ws-field-1 - move 475.062 to ws-field-2 - expect ws-field-1 not >= ws-field-2 + expect ws-field-1 not >= 475.062 TestCase "Not greater-than-or-equal-to-sign with field compare when greater (should fail)" move 475.063 to ws-field-1 - move 475.062 to ws-field-2 - expect ws-field-1 not >= ws-field-2 + expect ws-field-1 not >= 475.062 TestCase "Less-than-or-equal-to-sign with field compare when equal" move 475.062 to ws-field-1 - move 475.062 to ws-field-2 - expect ws-field-1 <= ws-field-2 + expect ws-field-1 <= 475.062 TestCase "Less-than-or-equal-to-sign with field compare when less" move 475.062 to ws-field-1 - move 475.063 to ws-field-2 - expect ws-field-1 <= ws-field-2 + expect ws-field-1 <= 475.063 TestCase "Less-than-or-equal-to-sign with field compare when greater (should fail)" move 475.063 to ws-field-1 - move 475.062 to ws-field-2 - expect ws-field-1 <= ws-field-2 + expect ws-field-1 <= 475.062 TestCase "Not less-than-or-equal-to-sign with field compare when greater" move 475.063 to ws-field-1 - move 475.062 to ws-field-2 - expect ws-field-1 not <= ws-field-2 + expect ws-field-1 not <= 475.062 - TestCase "Not greater-than-or-equal-to-sign with field compare when equal (should fail)" + TestCase "Not less-than-or-equal-to-sign with field compare when equal (should fail)" move 475.062 to ws-field-1 - move 475.062 to ws-field-2 - expect ws-field-1 not <= ws-field-2 + expect ws-field-1 not <= 475.062 - TestCase "Not greater-than-or-equal-to-sign with field compare when less (should fail)" + TestCase "Not less-than-or-equal-to-sign with field compare when less (should fail)" move 475.062 to ws-field-1 - move 475.063 to ws-field-2 - expect ws-field-1 not <= ws-field-2 + expect ws-field-1 not <= 475.063 TestCase "Display Numeric field equals literal" move 123.45 to ws-display-field expect ws-display-field to be 123.45 + TestCase "Display Numeric field equals literal with negative numbers" + move -123.45 to ws-display-field + expect ws-display-field to be -123.45 + + TestCase "Variable must be ZERO" + move zero to ws-field-3 + expect ws-field-3 to be zero + + TestCase "Variable must be ZEROS" + move zeros to ws-field-3 + expect ws-field-3 to be zeros + TestCase "Variable must be ZEROES" + move zeroes to ws-field-3 + expect ws-field-3 to be zeroes + TestCase "Variable must be NUMERIC 123" + move 123 to ws-field-3 + expect ws-field-3 to be numeric 123 + TestCase "Variable must be NUMERIC -123" + move -123 to ws-field-3 + expect ws-field-3 to be numeric -123 + TestCase "Variable must be 123" + move 123 to ws-field-3 + expect ws-field-3 to be 123 + TestCase "Variable must be -123" + move -123 to ws-field-3 + expect ws-field-3 to be -123 + TestCase "Variable must be 4" + move 4 to ws-num-occ (1) + expect ws-num-occ(1) to be numeric 4 diff --git a/vs-code-extension/client/src/extension.ts b/vs-code-extension/client/src/extension.ts index 4a369719..15f2abcf 100644 --- a/vs-code-extension/client/src/extension.ts +++ b/vs-code-extension/client/src/extension.ts @@ -20,7 +20,7 @@ import { getContentFromFilesystem, MarkdownTestData, TestCase, testData, TestFil let externalVsCodeInstallationDir = vscode.extensions.getExtension("openmainframeproject.cobol-check-extension").extensionPath; let configPath = appendPath(externalVsCodeInstallationDir, 'Cobol-check/config.properties'); let defaultConfigPath = appendPath(externalVsCodeInstallationDir, 'Cobol-check/default.properties'); -let cobolCheckJarPath = appendPath(externalVsCodeInstallationDir, 'Cobol-check/bin/cobol-check-0.2.17.jar'); +let cobolCheckJarPath = appendPath(externalVsCodeInstallationDir, 'Cobol-check/bin/cobol-check-0.2.18.jar'); let currentPlatform = getOS(); diff --git a/vs-code-extension/client/src/services/TestTree.ts b/vs-code-extension/client/src/services/TestTree.ts index cf039d15..b53971c3 100644 --- a/vs-code-extension/client/src/services/TestTree.ts +++ b/vs-code-extension/client/src/services/TestTree.ts @@ -10,7 +10,7 @@ import { handleCobolCheckOut } from '../Helpers/ExtensionHelper'; const textDecoder = new TextDecoder('utf-8'); let externalVsCodeInstallationDir = vscode.extensions.getExtension("openmainframeproject.cobol-check-extension").extensionPath; let configPath = appendPath(externalVsCodeInstallationDir, 'Cobol-check/config.properties'); -let cobolCheckJarPath = appendPath(externalVsCodeInstallationDir, 'Cobol-check/bin/cobol-check-0.2.17.jar'); +let cobolCheckJarPath = appendPath(externalVsCodeInstallationDir, 'Cobol-check/bin/cobol-check-0.2.18.jar'); diff --git a/vs-code-extension/package.json b/vs-code-extension/package.json index 9d625278..4ecd002c 100644 --- a/vs-code-extension/package.json +++ b/vs-code-extension/package.json @@ -8,7 +8,7 @@ "Snippets" ], "description": "Extension for running unit tests in Cobol", - "version": "0.4.11", + "version": "0.4.12", "icon": "images/cobol-check-logo-small.png", "repository": { "type": "git", @@ -40,7 +40,7 @@ } ], "description": "Extension for running unit tests in Cobol", - "version": "0.4.11", + "version": "0.4.12", "icon": "images/cobol-check-logo-small.png", "repository": { "type": "git",