Fix part 2 for DUMP of unreferenced LINKAGE fields

cobc/ChangeLog

@@ -1,4 +1,8 @@
 
+2022-05-17  Ron Norman <[email protected]>
+
+	* codegen.c : Emit original field offset in cob_symbol table
+
 2022-04-12  Ron Norman <[email protected]>
 
 	* cobc.c : Minor code reformat

cobc/codegen.c

@@ -2216,6 +2216,7 @@ emit_one_sym (struct cb_field *f)
 		output(",0");
 	}
 	output (",%d",f->occurs_max>1?f->occurs_max:0);
+	output (", %d",f->offset);
 	output ("}");
 	sym_comma = 1;
 }

libcob/ChangeLog

@@ -1,6 +1,7 @@
 
-2022-05-16  Ron Norman <[email protected]>
+2022-05-17  Ron Norman <[email protected]>
 
+	* common.h: Add 'roffset' to cob_symbol to hold original offset of field
 	* common.c: Fix issue with a dump incorrectly reporting 'CODEGEN ERROR'
 
 2022-04-12  Ron Norman <[email protected]>

libcob/common.c

@@ -9607,10 +9607,18 @@ cob_sym_get_field (cob_field *f, cob_symbol *sym, int k)
 	f->attr = sym[k].attr;
 	if (sym[k].is_indirect == SYM_ADRS_PTR) {
 		memcpy (&f->data, sym[k].adrs, sizeof(void*));
+		/* 
+		 * If field has not yet been referenced, the address will be NULL
+		 *   Scan up to parent and use that base address plus 'roffset'
+		 * If the field had been referenced the field address will be set
+		 *   and 'offset' will be ZERO
+		 */
 		for (j = k; f->data == NULL; j = sym[j].parent) {
 			if (sym[j].parent == 0) {	/* Base of COBOL Record */
 				memcpy (&f->data, sym[j].adrs, sizeof(void*));
-				break;
+				if (f->data != NULL)
+					f->data += sym[k].roffset;
+				return;
 			}
 		}
 		if (f->data != NULL)

libcob/common.h

@@ -1195,10 +1195,11 @@ typedef struct __cob_symbol {
 	unsigned int	has_depend:1;/* Field has DEPENDING ON */
 	unsigned int	subscripts:5;/* Field requires N subscripts */
 
-	unsigned int	offset;		/* Offset within record */
+	unsigned int	offset;		/* Offset in record, May be ZERO for LINKAGE fields */
 	unsigned int	size;		/* Field size */
 	unsigned int	depending;	/* Index to DEPENDING ON  field */
 	unsigned int	occurs;		/* Max number of OCCURS */
+	unsigned int	roffset;	/* Original Offset within record */
 } cob_symbol;
 
 /* Representation of 128 bit FP */

tests/testsuite.src/run_misc.at

@@ -8662,6 +8662,130 @@ AT_CHECK([gcdiff reference dumpall.txt], [0], [], [])
 
 AT_CLEANUP
 
+AT_SETUP([Test dump feature (5)])
+AT_KEYWORDS([Dump])
+
+AT_DATA([prog.cob], [       IDENTIFICATION DIVISION.
+       PROGRAM-ID. prog.
+       ENVIRONMENT DIVISION.
+       CONFIGURATION SECTION.
+
+       INPUT-OUTPUT SECTION.
+       FILE-CONTROL.
+       DATA  DIVISION.
+       FILE SECTION.
+       WORKING-STORAGE SECTION.
+       77  UNUSED-VAR        VALUE  1          PICTURE 9(4).
+       01  BIN                      PIC 9(9) BINARY VALUE 0.
+       01  PACKD                    PIC 9(4)V99 COMP-3 VALUE 757.99.
+
+       01  TSPFL-RECORD.
+           10  CM-CUST-NUM      PICTURE X(8)  VALUE "RON00001". 
+           10  CM-COMPANY       PICTURE X(25) VALUE "IBS Canada". 
+           10  CM-DISK          PICTURE X(8)  VALUE "4TB". 
+           10  CM-NO-TERMINALS  USAGE FLOAT.
+
+       PROCEDURE DIVISION.
+
+       MAIN-100.
+           MOVE 64.7 TO CM-NO-TERMINALS.
+            IF CM-NO-TERMINALS = 66
+                DISPLAY "What happened!"
+            END-IF.
+           PERFORM CALL-SUB-1.
+           STOP RUN.
+
+       CALL-SUB-1 SECTION.
+           CALL "sub1" USING bin, TSPFL-RECORD.
+
+           END PROGRAM prog.
+
+       IDENTIFICATION DIVISION.
+       PROGRAM-ID. sub1.
+       DATA DIVISION.
+       WORKING-STORAGE SECTION.
+       01  BAD-PTR      USAGE POINTER.
+
+       LINKAGE SECTION.
+       01  X          PIC 9 ANY NUMERIC.
+       01  TSP-RECORD.
+           10  CM-CUST-NUM                     PICTURE X(8). 
+           10  CM-COMPANY                      PICTURE X(25). 
+           10  CM-DISK                         PICTURE X(8). 
+           10  CM-NO-TERMINALS                 USAGE FLOAT.
+
+       PROCEDURE DIVISION USING X, TSP-RECORD.
+       MAIN-1 SECTION.
+            PERFORM DMP-TIME.
+            IF CM-NO-TERMINALS = 66
+                DISPLAY X "Miller time!"
+            END-IF.
+            GOBACK.
+       DMP-TIME1.
+            CALL BAD-PTR.
+       DMP-TIME.
+            PERFORM DMP-TIME1.
+       END PROGRAM sub1.
+])
+
+AT_CHECK([$COMPILE -std=default -debug -fdump=ALL prog.cob ], [0], [], [])
+
+AT_CHECK([export COB_DUMP_FILE=dumpall.txt
+$COBCRUN_DIRECT ./prog], [1], [], [libcob: prog.cob:58: error: module '' not found
+
+dump written to dumpall.txt
+])
+
+
+AT_CAPTURE_FILE(./dumpall.txt)
+
+AT_DATA([reference], [
+Module dump due to module '' not found
+
+ Last statement of "sub1" was at line 58 of prog.cob    
+ Last statement of "prog" was at line 32 of prog.cob    
+ Started by ./prog    
+
+Dump Program-Id sub1 from prog.cob compiled MMM DD YYYY HH:MI:SS
+
+WORKING-STORAGE
+**********************
+01        BAD-PTR                         0x0000000000000000
+
+LINKAGE
+**********************
+01        X                               000000000
+01        TSP-RECORD.
+     10   CM-CUST-NUM                    'RON00001'
+     10   CM-COMPANY                     'IBS Canada'
+     10   CM-DISK                        '4TB'
+     10   CM-NO-TERMINALS                 64.699997
+
+END OF DUMP - sub1
+**********************
+
+Dump Program-Id prog from prog.cob compiled MMM DD YYYY HH:MI:SS
+
+WORKING-STORAGE
+**********************
+77        UNUSED-VAR                      0001
+01        BIN                             000000000
+01        PACKD                           0757.99
+01        TSPFL-RECORD.
+     10   CM-CUST-NUM                    'RON00001'
+     10   CM-COMPANY                     'IBS Canada'
+     10   CM-DISK                        '4TB'
+     10   CM-NO-TERMINALS                 64.699997
+
+END OF DUMP - prog    
+**********************
+
+])
+
+AT_CHECK([gcdiff reference dumpall.txt], [0], [], [])
+
+AT_CLEANUP
+
 
 AT_SETUP([C-API Test (param based)])
 AT_KEYWORDS([CALL api])