Skip to content
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
38 changes: 38 additions & 0 deletions src/main/cobol/TEST-LINKAGE.CBL
Original file line number Diff line number Diff line change
@@ -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.
Original file line number Diff line number Diff line change
Expand Up @@ -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<String> matchingTestDirectories;

Expand Down Expand Up @@ -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);
}
}
}
}
Expand Down Expand Up @@ -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));
}
Expand Down
11 changes: 11 additions & 0 deletions src/test/cobol/TEST-LINKAGE/TestLinkageSection.cut
Original file line number Diff line number Diff line change
@@ -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'