REDEFINES


The REDEFINES allows one variable to share the same storage area as another variable. It is a way to declare multiple variables for a single storage area in different ways, depending on the requirement. The data items involved in a REDEFINES should be at the same level number and immediately follow the item being redefined in the declaration.

Syntax -

level-number target-variable REDEFINES source-variable [PIC ...].

Parameters -

  • level-number - The level number at which the variable is defined. It should be the same for both source and target variables.
  • target-variable - Name of the new variable that is going to share the storage of source-variable.
  • source-variable - Name of the variable whose storage is being redefined by target-variable.
  • PIC .. - Optional. Additional clauses that describe the data, like PIC, VALUE, etc.

Rules to remember -

  • A source variable can be redefined any number of times, and there is no limitation.
  • The source and target variables should be at the same level number.
  • The source or target variables can be redefined when they are defined with level numbers 01-49 or 77. However, they should not be defined with level 66 or 88.
  • The source or target variables should not be defined with an OCCURS DEPENDING ON clause.
  • The PICTURE clause is optional for REDEFINES.
  • The source or target variables type can be changed during the redefinition.
  • The source and target variables should have the same length ideally. However, the lengths may differ, and it is acceptable.
  • The source or target variables may have elementary variables.

Practical Example -


Scenario - Redefining a variable with same and different lengths used in COBOL programming.

Code -

----+----1----+----2----+----3----+----4----+----5----+
       IDENTIFICATION DIVISION.
       PROGRAM-ID. REDEFINE.
       AUTHOR. MTH.
	   
       DATA DIVISION.
       WORKING-STORAGE SECTION.
       01 WS-VAR.
	      05 WS-VAR1                      PIC X(20).
          05 WS-REQ-VAR1 REDEFINES WS-VAR PIC X(20). 
          05 WS-RLE-VAR2 REDEFINES WS-VAR PIC X(10).
          05 WS-RGT-VAR3 REDEFINES WS-VAR PIC X(30).

       PROCEDURE DIVISION.

           MOVE "MAINFRAME TECHNOLOGY"     TO WS-VAR1.
           DISPLAY "WS-VAR1:        " WS-VAR1.
           DISPLAY "WS-REQ-VAR1:   " WS-REQ-VAR1.
           DISPLAY "WS-RLE-VAR2:   " WS-RLE-VAR2.
           DISPLAY "WS-RGT-VAR3:   " WS-RGT-VAR3.
           DISPLAY " ".

           MOVE "MAINFRAME APPLICATION SYSTEM" TO WS-RGT-VAR3.
           DISPLAY "WS-VAR1:        " WS-VAR1.
           DISPLAY "WS-REQ-VAR1:   " WS-REQ-VAR1.
           DISPLAY "WS-RLE-VAR2:   " WS-RLE-VAR2.
           DISPLAY "WS-RGT-VAR3:   " WS-RGT-VAR3.

           STOP RUN. 

Output -

REDEFINES Program Output

Explaining Example -

  • WS-VAR1 is the source variable. WS-REQ-VAR1, WS-RLE-VAR2, and WS-RGT-VAR3 are the target variables on WS-VAR.
  • WS-REQ-VAR1 redefines WS-VAR1 with the same length of 20. So, WS-RLE-VAR1 and WS-VAR1 can have the same data.
  • WS-RLE-VAR2 redefines WS-VAR1 with a length of 10 that is less than WS-VAR1 length. So, WS-RLE-VAR2 has the first 10 bytes of WS-VAR data.
  • WS-RGT-VAR3 redefines WS-VAR1 of length 30, which is greater than WS-VAR1 length. So WS-RGT-VAR3 has the WS-VAR1 data plus another 10 bytes.
  • Initially, WS-VAR1 was assigned with "MAINFRAME TECHNOLOGY" and the redefined variables WS-REQ-VAR1, WS-RLE-VAR2, and WS-RGT-VAR3 also had the same data according to their defined lengths.
  • Later, the "MAINFRAME APPLICATION SYSTEM" was assigned to WS-RGT-VAR3. WS-VAR, WS-REQ-VAR1, WS-RLE-VAR2, and WS-RGT-VAR3 also have the same data according to their defined lengths.
Note! If changing data in source or target variables, the other variables data automatically changed. Because both variable points to same memory location.