Function
The INVOKE statement causes a method to be invoked.
Format
INVOKE identifier-1 {identifier-2 | literal-1}
[USING { [BY REFERENCE] {identifier-3 | OMITTED}
| [BY CONTENT] {identifier-5 | arithmetic-expression-1 | literal-2}
| [BY VALUE] {identifier-5 | arithmetic-expression-1 | literal-2}
}... ]
[ RETURNING
identifier-4 ]
[ON EXCEPTION imperative-statement-1]
[NOT ON EXCEPTION imperative-statement-2]
[END-INVOKE]
Syntax rules
identifier-1 must be an object reference or a class-name.
literal-1 must be an alphanumeric literal. However, it may not be a figurative constant.
If identifier-1 references a universal object reference, neither the BY CONTENT nor BY VALUE phrase must be specified and the BY REFERENCE phrase, if not specified explicitly, is assumed implicitly.
identifier-2 must be an alphanumeric data item.
identifier-3 must reference a data item defined in the FILE SECTION, WORKING-STORAGE SECTION, LOCAL-STORAGE SECTION or LINKAGE SECTION.
If identifier-5 or its corresponding formal parameter (in the PROCEDURE DIVISION header) is specified with the BY VALUE phrase, identifier-5 may only be of class “numeric”, “object” or “pointer”.
identifier-4 must reference a data item defined in the FILE SECTION, WORKING-STORAGE SECTION, LOCAL-STORAGE SECTION or LINKAGE SECTION.
If identifier-2 is specified, identifier-1 must be a universal object reference.
If identifier-1 is not a universal object reference, the rules for conformance as specified for parameters and returning items apply.
If identifier-1 is not a universal object reference and a BY CONTENT or BY REFERENCE phrase is specified for an argument, a BY REFERENCE phrase must be specified for the corresponding formal parameter in the Procedure Division header.
BY CONTENT may not be omitted if identifier-5 is permitted as a receiving item.
If a BY VALUE phrase is specified for an argument, a BY VALUE phrase must also be specified for the corresponding formal parameter in the Procedure Division header.
If an OMITTED phrase is specified, an OPTIONAL phrase must also be specified for the corresponding formal parameter in the Procedure Division header.
If identifier-1 is a universal object reference then the formal parameters and formal return element must not be defined with the ANY LENGTH clause.
If identifier-3 or identifier-4 are defined with the ANY LENGTH-clause, then the corresponding formal parameter must also be defined with the ANY LENGTH clause. If identifier-5 is defined with the ANY LENGTH clause then the corresponding formal parameter must not be defined with the ANY LENGTH clause.
If the formal parameter corresponding to identifier-5 is defined with the ANY LENGTH clause the identifier-5 must be of the class “alphabetic” or “alphanumeric”.
identifier-5 and any identifier specified in arithmetic-expression-1 are send operands.
identifier-4 is a receiving item.
identifier-3 must reference an address identifier or an elementary data item which is defined in the FILE SECTION, WORKING-STORAGE SECTION, LOCAL-STORAGE SECTION or LINKAGE-SECTION.
If the BY REFERENCE phrase is specified or implied for identifier-3, which is not an address identifier, then identifier-3 represents both a sending and a receiving item. In all other cases, identifier-3 specifies a sending item.
Note:
The specification BY REFERENCE ADDRESS OF data-name is processed in the same way as BYCONTENT ADDRESS OF data-name.
General rules
identifier-1 identifies an object instance. If a class-name is specified as identifier-1, it identifies the factory object of that class-name. Literal-1 or the content of the data item referenced by identifier-2 identifies a method of that object that will act upon that object instance.
literal-1 or the content of the identifier-2 is the name of the method to be invoked as specified in the corresponding METHOD-ID paragraph (as a COBOL word).The sequence of arguments in the USING phrase of the INVOKE statement and the corresponding formal parameters in the USING phrase of the invoked method’s Procedure Division header determines the correspondence between arguments and formal parameters. This correspondence is positional and not by name equivalence. The first argument corresponds to the first formal parameter, the second to the second parameter, and the nth to the nth parameter.
An argument that consists merely of a single identifier or literal is regarded as an identifier or literal rather than an arithmetic expression.
If identifier-1 is null, an exception condition EC-OO-NULL occurs, no method is activated, and the execution proceeds as specified in general rule 6f.
If identifier-1 is not a universal object reference and an argument without any of the keywords BY REFERENCE, BY CONTENT, or BY VALUE is specified, that argument is handled as follows:
BY REFERENCE is assumed if the BY REFERENCE phrase is specified or implied for the corresponding formal parameter and if the argument is an identifier that is permitted as the receiving item.
BY CONTENT is assumed if the BY REFERENCE phrase is specified or implied for the corresponding formal parameter and if the argument is a literal, an arithmetic expression or any other identifier that is not permitted as the receiving item.
BY VALUE is assumed if the BY VALUE phrase is specified or implied for the corresponding formal parameter.
Execution of the INVOKE statement proceeds as follows:
arithmetic-expression-1, identifier-1, identifier-2, identifier-3, and identifier-5 are evaluated and item identification is done for identifier-4 at the beginning of the execution of the INVOKE statement. If an exception condition exists, no method is invoked and execution proceeds as specified in general rule 6f.
The runtime system attempts to locate the invoked method. If the method cannot be located or the resources necessary to execute the method are not available, the exception condition EC-OO-METHOD occurs. The method is not activated, and execution continues as specified in general rule 6f.
If identifier-1 is a universal object reference, the conformance rules for parameters and returning items must apply. If a violation of these rules is detected, an exception condition EC-OO-UNIVERSAL, the method is not activated, and execution continues as specified in general rule 6f.
The method specified by the INVOKE statement is made available for execution and control is transferred to the invoked method (in conformance with the calling conventions).
After control is returned from the invoked method, imperative-statement-2 is executed if present, and control is transferred to the end of the INVOKE statement.
If one of the exception conditions EC-OO-NULL, EC-OO-METHOD or EC-OO-UNIVERSAL has occurred, the following procedure results:
If ON EXCEPTION is specified, control is transferred to imperative-statement-1 and then to the end of the INVOKE statement. The associated exception condition is not triggered.
If ON EXCEPTION is not specified and the check of the exception condition is activated, the associated exception condition is triggered and control is transferred to the relevant USE procedure. After RESUME NEXT StATEMENT has been executed in the USE procedure, imperative-statement-2 is ignored and processing continues with the next executable statement after the end of the INVOKE statement.
If ON EXCEPTION is not specified and the check of the exception condition is not activated but NOT ON EXCEPTION is specified, imperative-statement-2 is ignored and processing continues with the next executable statement after the end of the INVOKE statement.
If neither ON EXCEPTION nor NOT ON EXCEPTION is specified and the check of the exception condition is not activated, the program run is aborted.
If the check of the exception condition is not activated, the program run is aborted.If a RETURNING phrase is specified, the result of the invoked method is placed in identifier-4.
If an OMITTED phrase is specified or an argument is completely omitted, the omitted-argument condition for that parameter is true in the invoked method.
If a parameter for which the omitted-argument condition is true for a parameter and this is referenced in an invoked method (except in an omitted-argument condition), the behavior is undefined.