Classes and objects form the foundation of object-oriented programming in COBOL. A class is a blueprint that defines the structure and behavior of objects, while objects are specific instances of classes that contain actual data and can perform operations. Understanding this relationship is crucial for effective object-oriented COBOL development.
Think of a class as a cookie cutter and objects as the actual cookies made from that cutter. The class defines what properties (like size, shape) and methods (like baking instructions) all objects of that type will have. Each object is a unique instance with its own specific values for those properties, but they all follow the same pattern defined by the class.
A class in COBOL is defined using the CLASS-ID statement in the IDENTIFICATION DIVISION. This creates a template that describes what properties and methods all objects of this class will have. The class definition is like a blueprint that specifies the structure but doesn't contain actual data.
12345678910111213141516171819IDENTIFICATION DIVISION. CLASS-ID. BANK-ACCOUNT. *> This defines a class called BANK-ACCOUNT *> All bank account objects will have the properties and methods defined here ENVIRONMENT DIVISION. CONFIGURATION SECTION. *> Configuration settings for the class DATA DIVISION. WORKING-STORAGE SECTION. *> Class properties - these define what data each object will contain 01 ACCOUNT-NUMBER PIC 9(10) VALUE ZERO. 01 ACCOUNT-HOLDER-NAME PIC X(50) VALUE SPACES. 01 ACCOUNT-BALANCE PIC 9(10)V99 VALUE ZERO. 01 ACCOUNT-TYPE PIC X(10) VALUE 'CHECKING'. PROCEDURE DIVISION. *> Class methods - these define what operations objects can perform
The CLASS-ID statement creates a new class definition. The properties defined in the WORKING-STORAGE SECTION represent the data that each object instance will contain. For example, every bank account object will have its own account number, holder name, balance, and account type. The PROCEDURE DIVISION will contain methods that define what operations these objects can perform.
Methods define the operations that objects of this class can perform. Each method is like a function that operates on the object's data. Methods can accept parameters, perform calculations, modify the object's properties, and return results to the calling code.
12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849PROCEDURE DIVISION. METHOD-ID. DEPOSIT. *> This method allows depositing money into the account *> Parameters: amount to deposit DATA DIVISION. LINKAGE SECTION. 01 DEPOSIT-AMOUNT PIC 9(8)V99. 01 TRANSACTION-SUCCESS PIC X(1). 88 SUCCESS VALUE 'Y'. 88 FAILURE VALUE 'N'. PROCEDURE DIVISION USING DEPOSIT-AMOUNT RETURNING TRANSACTION-SUCCESS. *> Validate the deposit amount IF DEPOSIT-AMOUNT > 0 ADD DEPOSIT-AMOUNT TO ACCOUNT-BALANCE SET SUCCESS TO TRUE DISPLAY 'Deposit successful. New balance: ' ACCOUNT-BALANCE ELSE SET FAILURE TO TRUE DISPLAY 'Invalid deposit amount' END-IF END METHOD DEPOSIT. METHOD-ID. WITHDRAW. *> This method allows withdrawing money from the account *> Parameters: amount to withdraw DATA DIVISION. LINKAGE SECTION. 01 WITHDRAWAL-AMOUNT PIC 9(8)V99. 01 TRANSACTION-SUCCESS PIC X(1). 88 SUCCESS VALUE 'Y'. 88 FAILURE VALUE 'N'. PROCEDURE DIVISION USING WITHDRAWAL-AMOUNT RETURNING TRANSACTION-SUCCESS. *> Check if sufficient funds are available IF WITHDRAWAL-AMOUNT <= ACCOUNT-BALANCE AND WITHDRAWAL-AMOUNT > 0 SUBTRACT WITHDRAWAL-AMOUNT FROM ACCOUNT-BALANCE SET SUCCESS TO TRUE DISPLAY 'Withdrawal successful. New balance: ' ACCOUNT-BALANCE ELSE SET FAILURE TO TRUE DISPLAY 'Insufficient funds or invalid amount' END-IF END METHOD WITHDRAW.
Each method is defined using METHOD-ID and includes its own DATA DIVISION for parameters and return values. The DEPOSIT method adds money to the account balance after validating the amount, while the WITHDRAW method checks for sufficient funds before allowing a withdrawal. These methods encapsulate the business logic for account operations and protect the account data from invalid operations.
Objects are created from classes using the INVOKE statement with the NEW method. This process is called instantiation - it creates a specific instance of the class with its own memory space for data. Each object is independent and has its own values for the class properties.
12345678910111213141516171819202122232425262728293031323334353637383940414243IDENTIFICATION DIVISION. PROGRAM-ID. BANK-ACCOUNT-DEMO. *> This program demonstrates how to create and use bank account objects DATA DIVISION. WORKING-STORAGE SECTION. *> Object references - these point to specific object instances 01 ACCOUNT-1 USAGE OBJECT REFERENCE. 01 ACCOUNT-2 USAGE OBJECT REFERENCE. 01 ACCOUNT-3 USAGE OBJECT REFERENCE. *> Variables for method parameters and return values 01 DEPOSIT-AMOUNT PIC 9(8)V99 VALUE 1000.00. 01 WITHDRAWAL-AMOUNT PIC 9(8)V99 VALUE 250.00. 01 TRANSACTION-RESULT PIC X(1). PROCEDURE DIVISION. MAIN-LOGIC. DISPLAY 'Creating bank account objects...' *> Create three different bank account objects INVOKE BANK-ACCOUNT "NEW" RETURNING ACCOUNT-1 INVOKE BANK-ACCOUNT "NEW" RETURNING ACCOUNT-2 INVOKE BANK-ACCOUNT "NEW" RETURNING ACCOUNT-3 *> Verify that objects were created successfully IF ACCOUNT-1 = NULL DISPLAY 'ERROR: Failed to create Account 1' STOP RUN END-IF IF ACCOUNT-2 = NULL DISPLAY 'ERROR: Failed to create Account 2' STOP RUN END-IF IF ACCOUNT-3 = NULL DISPLAY 'ERROR: Failed to create Account 3' STOP RUN END-IF DISPLAY 'All bank account objects created successfully' PERFORM USE-ACCOUNTS.
The INVOKE statement with "NEW" creates a new instance of the BANK-ACCOUNT class. Each object reference (ACCOUNT-1, ACCOUNT-2, ACCOUNT-3) points to a separate object with its own memory space. The NULL check ensures that object creation was successful before proceeding. Each object is completely independent - changes to one account won't affect the others.
Once objects are created, you can call their methods using the INVOKE statement with the object reference. Each object maintains its own state (property values), so calling the same method on different objects can produce different results based on each object's current data.
12345678910111213141516171819202122232425262728293031323334353637USE-ACCOUNTS. *> Demonstrate using different account objects DISPLAY 'Using Account 1...' *> Deposit money into Account 1 INVOKE ACCOUNT-1 "DEPOSIT" USING DEPOSIT-AMOUNT RETURNING TRANSACTION-RESULT IF TRANSACTION-RESULT = 'Y' DISPLAY 'Account 1 deposit successful' ELSE DISPLAY 'Account 1 deposit failed' END-IF *> Withdraw money from Account 1 INVOKE ACCOUNT-1 "WITHDRAW" USING WITHDRAWAL-AMOUNT RETURNING TRANSACTION-RESULT IF TRANSACTION-RESULT = 'Y' DISPLAY 'Account 1 withdrawal successful' ELSE DISPLAY 'Account 1 withdrawal failed' END-IF *> Use Account 2 with different amounts DISPLAY 'Using Account 2...' MOVE 500.00 TO DEPOSIT-AMOUNT MOVE 100.00 TO WITHDRAWAL-AMOUNT INVOKE ACCOUNT-2 "DEPOSIT" USING DEPOSIT-AMOUNT RETURNING TRANSACTION-RESULT INVOKE ACCOUNT-2 "WITHDRAW" USING WITHDRAWAL-AMOUNT RETURNING TRANSACTION-RESULT *> Account 3 remains unused with zero balance DISPLAY 'Account 3 has not been used yet'.
This code demonstrates how each object maintains its own state independently. Account 1 receives a $1000 deposit and a $250 withdrawal, Account 2 receives a $500 deposit and a $100 withdrawal, while Account 3 remains untouched with its initial zero balance. Each object's balance is tracked separately, showing how objects encapsulate their own data.
Object properties can be accessed through getter and setter methods, which provide controlled access to the object's internal data. This approach maintains encapsulation by preventing direct access to object properties while still allowing necessary data retrieval and modification.
12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152METHOD-ID. GET-BALANCE. *> This method returns the current account balance *> Returns: current balance DATA DIVISION. LINKAGE SECTION. 01 CURRENT-BALANCE PIC 9(10)V99. PROCEDURE DIVISION RETURNING CURRENT-BALANCE. *> Return the current balance value MOVE ACCOUNT-BALANCE TO CURRENT-BALANCE END METHOD GET-BALANCE. METHOD-ID. GET-ACCOUNT-INFO. *> This method returns all account information *> Returns: account number, holder name, balance, and type DATA DIVISION. LINKAGE SECTION. 01 ACCOUNT-NUMBER-OUT PIC 9(10). 01 ACCOUNT-HOLDER-OUT PIC X(50). 01 ACCOUNT-BALANCE-OUT PIC 9(10)V99. 01 ACCOUNT-TYPE-OUT PIC X(10). PROCEDURE DIVISION RETURNING ACCOUNT-NUMBER-OUT ACCOUNT-HOLDER-OUT ACCOUNT-BALANCE-OUT ACCOUNT-TYPE-OUT. *> Return all account properties MOVE ACCOUNT-NUMBER TO ACCOUNT-NUMBER-OUT MOVE ACCOUNT-HOLDER-NAME TO ACCOUNT-HOLDER-OUT MOVE ACCOUNT-BALANCE TO ACCOUNT-BALANCE-OUT MOVE ACCOUNT-TYPE TO ACCOUNT-TYPE-OUT END METHOD GET-ACCOUNT-INFO. METHOD-ID. SET-ACCOUNT-HOLDER. *> This method sets the account holder name *> Parameters: new holder name DATA DIVISION. LINKAGE SECTION. 01 NEW-HOLDER-NAME PIC X(50). PROCEDURE DIVISION USING NEW-HOLDER-NAME. *> Validate and set the holder name IF NEW-HOLDER-NAME NOT = SPACES MOVE NEW-HOLDER-NAME TO ACCOUNT-HOLDER-NAME DISPLAY 'Account holder name updated' ELSE DISPLAY 'Invalid holder name provided' END-IF END METHOD SET-ACCOUNT-HOLDER.
Getter methods like GET-BALANCE and GET-ACCOUNT-INFO provide read-only access to object properties, allowing external code to retrieve information without being able to modify it directly. Setter methods like SET-ACCOUNT-HOLDER provide controlled modification of properties, including validation to ensure data integrity. This pattern maintains encapsulation while providing necessary access to object data.
Objects maintain their state through their properties, and this state can change over time as methods are called. Understanding how state changes affect object behavior is crucial for effective object-oriented programming. Each object instance has its own independent state.
1234567891011121314151617181920212223242526272829303132DEMONSTRATE-OBJECT-STATE. *> Show how object state changes over time DISPLAY 'Demonstrating object state changes...' *> Check initial state of Account 1 INVOKE ACCOUNT-1 "GET-BALANCE" RETURNING CURRENT-BALANCE DISPLAY 'Account 1 initial balance: ' CURRENT-BALANCE *> Perform transactions that change the state MOVE 2000.00 TO DEPOSIT-AMOUNT INVOKE ACCOUNT-1 "DEPOSIT" USING DEPOSIT-AMOUNT RETURNING TRANSACTION-RESULT *> Check state after deposit INVOKE ACCOUNT-1 "GET-BALANCE" RETURNING CURRENT-BALANCE DISPLAY 'Account 1 balance after deposit: ' CURRENT-BALANCE *> Perform another transaction MOVE 750.00 TO WITHDRAWAL-AMOUNT INVOKE ACCOUNT-1 "WITHDRAW" USING WITHDRAWAL-AMOUNT RETURNING TRANSACTION-RESULT *> Check final state INVOKE ACCOUNT-1 "GET-BALANCE" RETURNING CURRENT-BALANCE DISPLAY 'Account 1 final balance: ' CURRENT-BALANCE *> Show that other accounts maintain their own independent state INVOKE ACCOUNT-2 "GET-BALANCE" RETURNING CURRENT-BALANCE DISPLAY 'Account 2 balance (unchanged): ' CURRENT-BALANCE INVOKE ACCOUNT-3 "GET-BALANCE" RETURNING CURRENT-BALANCE DISPLAY 'Account 3 balance (unchanged): ' CURRENT-BALANCE.
This demonstration shows how object state changes over time as methods are called. Account 1's balance changes from its initial value to reflect deposits and withdrawals, while Accounts 2 and 3 maintain their own independent states. This illustrates the key concept that each object instance has its own memory space and state, separate from other instances of the same class.
Inheritance allows new classes to be created based on existing classes, inheriting their properties and methods while adding new functionality. This creates a hierarchy where subclasses are more specialized versions of their parent classes, following the "is-a" relationship principle.
1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859IDENTIFICATION DIVISION. CLASS-ID. SAVINGS-ACCOUNT INHERITS FROM BANK-ACCOUNT. *> This class inherits all properties and methods from BANK-ACCOUNT *> It adds savings-specific functionality like interest calculation DATA DIVISION. WORKING-STORAGE SECTION. *> Additional properties specific to savings accounts 01 INTEREST-RATE PIC 9(3)V99 VALUE 2.50. 01 MINIMUM-BALANCE PIC 9(8)V99 VALUE 100.00. 01 INTEREST-EARNED PIC 9(8)V99 VALUE ZERO. PROCEDURE DIVISION. METHOD-ID. CALCULATE-INTEREST. *> This method calculates interest based on current balance *> Returns: interest amount earned DATA DIVISION. LINKAGE SECTION. 01 INTEREST-AMOUNT PIC 9(8)V99. PROCEDURE DIVISION RETURNING INTEREST-AMOUNT. *> Calculate interest only if minimum balance is maintained IF ACCOUNT-BALANCE >= MINIMUM-BALANCE COMPUTE INTEREST-AMOUNT = ACCOUNT-BALANCE * (INTEREST-RATE / 100) ADD INTEREST-AMOUNT TO INTEREST-EARNED DISPLAY 'Interest calculated: ' INTEREST-AMOUNT ELSE MOVE ZERO TO INTEREST-AMOUNT DISPLAY 'Minimum balance not maintained - no interest' END-IF END METHOD CALCULATE-INTEREST. METHOD-ID. WITHDRAW. *> This method overrides the inherited WITHDRAW method *> It adds savings account specific rules DATA DIVISION. LINKAGE SECTION. 01 WITHDRAWAL-AMOUNT PIC 9(8)V99. 01 TRANSACTION-SUCCESS PIC X(1). 88 SUCCESS VALUE 'Y'. 88 FAILURE VALUE 'N'. PROCEDURE DIVISION USING WITHDRAWAL-AMOUNT RETURNING TRANSACTION-SUCCESS. *> Check minimum balance requirement for savings accounts IF ACCOUNT-BALANCE - WITHDRAWAL-AMOUNT >= MINIMUM-BALANCE SUBTRACT WITHDRAWAL-AMOUNT FROM ACCOUNT-BALANCE SET SUCCESS TO TRUE DISPLAY 'Savings withdrawal successful' ELSE SET FAILURE TO TRUE DISPLAY 'Withdrawal would violate minimum balance requirement' END-IF END METHOD WITHDRAW.
The SAVINGS-ACCOUNT class inherits all properties and methods from BANK-ACCOUNT but adds savings-specific functionality. It includes an interest rate, minimum balance requirement, and interest calculation method. The WITHDRAW method is overridden to enforce the minimum balance rule specific to savings accounts. This demonstrates how inheritance allows code reuse while enabling specialization.
Polymorphism allows objects of different classes to be treated uniformly through their common interface. This means you can have a collection of different account types (regular and savings) and call the same methods on all of them, with each object responding according to its specific implementation.
1234567891011121314151617181920212223242526272829303132333435363738DEMONSTRATE-POLYMORPHISM. *> Create objects of different account types INVOKE BANK-ACCOUNT "NEW" RETURNING REGULAR-ACCOUNT INVOKE SAVINGS-ACCOUNT "NEW" RETURNING SAVINGS-ACCOUNT *> Deposit money into both accounts MOVE 1000.00 TO DEPOSIT-AMOUNT INVOKE REGULAR-ACCOUNT "DEPOSIT" USING DEPOSIT-AMOUNT RETURNING TRANSACTION-RESULT INVOKE SAVINGS-ACCOUNT "DEPOSIT" USING DEPOSIT-AMOUNT RETURNING TRANSACTION-RESULT *> Try to withdraw from both accounts MOVE 950.00 TO WITHDRAWAL-AMOUNT *> Regular account withdrawal (no minimum balance restriction) INVOKE REGULAR-ACCOUNT "WITHDRAW" USING WITHDRAWAL-AMOUNT RETURNING TRANSACTION-RESULT IF TRANSACTION-RESULT = 'Y' DISPLAY 'Regular account withdrawal successful' ELSE DISPLAY 'Regular account withdrawal failed' END-IF *> Savings account withdrawal (enforces minimum balance) INVOKE SAVINGS-ACCOUNT "WITHDRAW" USING WITHDRAWAL-AMOUNT RETURNING TRANSACTION-RESULT IF TRANSACTION-RESULT = 'Y' DISPLAY 'Savings account withdrawal successful' ELSE DISPLAY 'Savings account withdrawal failed' END-IF *> Calculate interest on savings account (method not available on regular account) INVOKE SAVINGS-ACCOUNT "CALCULATE-INTEREST" RETURNING INTEREST-AMOUNT DISPLAY 'Interest earned: ' INTEREST-AMOUNT.
This code demonstrates polymorphism by treating both account types uniformly for common operations like deposits and withdrawals. However, each account type responds differently based on its specific implementation - the regular account allows the withdrawal while the savings account rejects it due to the minimum balance requirement. The savings account also has additional functionality (interest calculation) that the regular account doesn't have.
Objects need to be properly initialized when created to ensure they start in a valid state. This includes setting initial values for properties, allocating any necessary resources, and performing any required setup operations. Proper initialization prevents objects from being in an undefined or invalid state.
12345678910111213141516171819202122232425262728293031323334353637383940METHOD-ID. INITIALIZE-ACCOUNT. *> This method initializes a new account with default values *> Parameters: account number, holder name, account type DATA DIVISION. LINKAGE SECTION. 01 INIT-ACCOUNT-NUMBER PIC 9(10). 01 INIT-HOLDER-NAME PIC X(50). 01 INIT-ACCOUNT-TYPE PIC X(10). PROCEDURE DIVISION USING INIT-ACCOUNT-NUMBER INIT-HOLDER-NAME INIT-ACCOUNT-TYPE. *> Set initial account properties MOVE INIT-ACCOUNT-NUMBER TO ACCOUNT-NUMBER MOVE INIT-HOLDER-NAME TO ACCOUNT-HOLDER-NAME MOVE INIT-ACCOUNT-TYPE TO ACCOUNT-TYPE MOVE ZERO TO ACCOUNT-BALANCE *> Validate initial data IF ACCOUNT-NUMBER > 0 AND ACCOUNT-HOLDER-NAME NOT = SPACES DISPLAY 'Account initialized successfully' DISPLAY 'Account: ' ACCOUNT-NUMBER ' for ' ACCOUNT-HOLDER-NAME ELSE DISPLAY 'ERROR: Invalid account initialization data' END-IF END METHOD INITIALIZE-ACCOUNT. METHOD-ID. RESET-ACCOUNT. *> This method resets the account to initial state PROCEDURE DIVISION. *> Reset all properties to default values MOVE ZERO TO ACCOUNT-NUMBER MOVE SPACES TO ACCOUNT-HOLDER-NAME MOVE ZERO TO ACCOUNT-BALANCE MOVE 'CHECKING' TO ACCOUNT-TYPE DISPLAY 'Account reset to initial state' END METHOD RESET-ACCOUNT.
The INITIALIZE-ACCOUNT method sets up a new account with specific values, while RESET-ACCOUNT returns the account to its default state. This ensures that objects always start in a known, valid state. The initialization method includes validation to ensure that the provided data is reasonable before setting the account properties.
When objects are no longer needed, they should be properly cleaned up to free resources and prevent memory leaks. This is especially important in long-running applications where many objects might be created and destroyed over time.
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748CLEANUP-OBJECTS. *> Properly dispose of objects when no longer needed DISPLAY 'Cleaning up account objects...' *> Check if objects exist before cleaning up IF ACCOUNT-1 NOT = NULL INVOKE ACCOUNT-1 "FINALIZE" SET ACCOUNT-1 TO NULL DISPLAY 'Account 1 cleaned up' END-IF IF ACCOUNT-2 NOT = NULL INVOKE ACCOUNT-2 "FINALIZE" SET ACCOUNT-2 TO NULL DISPLAY 'Account 2 cleaned up' END-IF IF ACCOUNT-3 NOT = NULL INVOKE ACCOUNT-3 "FINALIZE" SET ACCOUNT-3 TO NULL DISPLAY 'Account 3 cleaned up' END-IF IF REGULAR-ACCOUNT NOT = NULL INVOKE REGULAR-ACCOUNT "FINALIZE" SET REGULAR-ACCOUNT TO NULL DISPLAY 'Regular account cleaned up' END-IF IF SAVINGS-ACCOUNT NOT = NULL INVOKE SAVINGS-ACCOUNT "FINALIZE" SET SAVINGS-ACCOUNT TO NULL DISPLAY 'Savings account cleaned up' END-IF DISPLAY 'All objects cleaned up successfully'. METHOD-ID. FINALIZE. *> This method performs cleanup when the object is destroyed PROCEDURE DIVISION. *> Log the account closure DISPLAY 'Closing account: ' ACCOUNT-NUMBER DISPLAY 'Final balance: ' ACCOUNT-BALANCE *> Perform any necessary cleanup operations *> (e.g., save final state, close files, etc.) END METHOD FINALIZE.
The cleanup process ensures that objects are properly disposed of when they're no longer needed. The FINALIZE method is called on each object to perform any necessary cleanup operations, and then the object references are set to NULL to prevent accidental reuse. This prevents memory leaks and ensures proper resource management.