diff --git a/gcc/cobol/UAT/failsuite.src/run_functions.at b/gcc/cobol/UAT/failsuite.src/run_functions.at
index 6cd43f4ae8b692cae9e4eccc369654786022cca2..60f90e2c1a4b256e3d4da19067dab9014221496c 100644
--- a/gcc/cobol/UAT/failsuite.src/run_functions.at
+++ b/gcc/cobol/UAT/failsuite.src/run_functions.at
@@ -21,275 +21,6 @@
### ISO+IEC+1989-2002 15 Intrinsic Functions
### ISO+IEC+1989-2002 9.4 User-Defined Functions
-AT_SETUP([FUNCTION ABS])
-AT_KEYWORDS([functions])
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 X PIC S9(4)V9(4) VALUE -1.2345.
- PROCEDURE DIVISION.
- COMPUTE X = FUNCTION ABS( X )
- DISPLAY X
- END-DISPLAY.
- STOP RUN.
-])
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0],
-[+0001.2345
-])
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION ACOS])
-AT_KEYWORDS([functions])
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 Z PIC S9V9(33).
- PROCEDURE DIVISION.
- MOVE FUNCTION ACOS ( -0.2345 ) TO Z.
- IF Z NOT = 1.807500521108243435101500438523210
- DISPLAY Z
- END-DISPLAY
- END-IF.
- STOP RUN.
-])
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION ANNUITY])
-AT_KEYWORDS([functions])
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 Z PIC S9V9(33).
- PROCEDURE DIVISION.
- MOVE FUNCTION ANNUITY ( 3, 5 ) TO Z.
- IF Z NOT = 3.002932551319648093841642228739002
- DISPLAY Z
- END-DISPLAY
- END-IF.
- STOP RUN.
-])
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION ASIN])
-AT_KEYWORDS([functions])
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 Y PIC S9V9(33).
- PROCEDURE DIVISION.
- MOVE FUNCTION ASIN ( -0.2345 ) TO Y.
- IF Y NOT = -0.236704194313346815870178746883458
- DISPLAY Y
- END-DISPLAY
- END-IF.
- STOP RUN.
-])
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION ATAN])
-AT_KEYWORDS([functions])
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 Y PIC S9V9(33).
- PROCEDURE DIVISION.
- MOVE FUNCTION ATAN ( 1 ) TO Y.
- IF Y NOT = 0.785398163397448309615660845819875
- DISPLAY Y
- END-DISPLAY
- END-IF.
- STOP RUN.
-])
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION BYTE-LENGTH])
-AT_KEYWORDS([functions length])
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 X PIC X(4).
- 01 TEST-FLD PIC S9(04)V9(08).
- PROCEDURE DIVISION.
- MOVE FUNCTION BYTE-LENGTH ( TEST-FLD ) TO TEST-FLD.
- DISPLAY "BYTE-LENGTH of PIC S9(04)V9(08) is " TEST-FLD
- MOVE FUNCTION BYTE-LENGTH ( X ) TO TEST-FLD.
- DISPLAY "BYTE-LENGTH of PIC X(4) is " TEST-FLD
- MOVE FUNCTION BYTE-LENGTH ( '00128' ) TO TEST-FLD
- DISPLAY "BYTE-LENGTH of PIC '00128' is " TEST-FLD
- MOVE FUNCTION BYTE-LENGTH ( x'a0' ) TO TEST-FLD
- DISPLAY "BYTE-LENGTH of PIC x'a0' is " TEST-FLD
- STOP RUN.
-])
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [BYTE-LENGTH of PIC S9(04)V9(08) is +0012.00000000
-BYTE-LENGTH of PIC X(4) is +0004.00000000
-BYTE-LENGTH of PIC '00128' is +0005.00000000
-BYTE-LENGTH of PIC x'a0' is +0001.00000000
-], [])
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION CHAR])
-AT_KEYWORDS([functions])
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 X PIC S9(4)V9(4) VALUE 108.
- 01 TEST-FLD.
- 05 TEST-DATA PIC X(01).
- 88 VALID-DATA VALUE 'k'.
- 05 TEST-UNSET PIC X VALUE '_'.
- 88 VALID-UNSET VALUE '_'.
- PROCEDURE DIVISION.
- STRING FUNCTION CHAR ( X )
- DELIMITED BY SIZE
- INTO TEST-FLD
- END-STRING.
- EVALUATE TRUE
- WHEN NOT VALID-UNSET
- DISPLAY "FUNCTION result too long"
- END-DISPLAY
- WHEN VALID-DATA
- CONTINUE
- WHEN OTHER
- DISPLAY TEST-DATA
- END-DISPLAY
- END-EVALUATE.
- STOP RUN.
-])
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION COMBINED-DATETIME])
-AT_KEYWORDS([functions])
-
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 TEST-FLD PIC S9(04)V9(08).
- PROCEDURE DIVISION.
- MOVE FUNCTION COMBINED-DATETIME ( 987, 345.6 )
- TO TEST-FLD.
- IF TEST-FLD NOT = 987.003456
- DISPLAY TEST-FLD
- END-DISPLAY
- END-IF.
- STOP RUN.
-])
-
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
-
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION CONCAT / CONCATENATE])
-AT_KEYWORDS([functions])
-
-# note: CONCAT was added in COBOL 202x with GnuCOBOL's CONCATENATE
-# as blueprint
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 Y PIC X(4).
- 01 TEST-FLD.
- 05 TEST-DATA PIC X(14).
- 88 VALID-DATA VALUE 'defxabczz55666'.
- 05 TEST-UNSET PIC X VALUE '_'.
- 88 VALID-UNSET VALUE '_'.
- PROCEDURE DIVISION.
- MOVE "defx" TO Y.
- STRING FUNCTION CONCAT ( Y "abc" "zz" "55" "666" )
- DELIMITED BY SIZE
- INTO TEST-FLD
- END-STRING.
- EVALUATE TRUE
- WHEN NOT VALID-UNSET
- DISPLAY "FUNCTION result too long"
- END-DISPLAY
- WHEN TEST-DATA
- <> FUNCTION CONCAT ( Y "abc" "zz" "55" "666" )
- DISPLAY "CONCAT issue, '" TEST-DATA
- "' vs. '"
- FUNCTION CONCAT ( Y "abc" "zz" "55" "666" ) "'"
- END-DISPLAY
- WHEN VALID-DATA
- CONTINUE
- WHEN OTHER
- DISPLAY TEST-DATA
- END-DISPLAY
- END-EVALUATE.
- STOP RUN.
-])
-
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
-
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION CONCAT with reference modding])
-AT_KEYWORDS([functions])
-
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 Y PIC X(4).
- 01 TEST-FLD PIC X(9) VALUE SPACES.
- PROCEDURE DIVISION.
- MOVE 'defx' TO Y.
- MOVE FUNCTION CONCAT
- ( Y "abc" "zz" "55" "666" ) (2 : 9)
- TO TEST-FLD.
- IF TEST-FLD NOT = 'efxabczz5'
- DISPLAY TEST-FLD
- END-DISPLAY
- END-IF.
- STOP RUN.
-])
-
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
-
-AT_CLEANUP
-
-
AT_SETUP([FUNCTION CONTENT-LENGTH])
AT_KEYWORDS([functions length])
AT_XFAIL_IF([test "$COB_DIALECT" != "gnu"])
@@ -394,68 +125,6 @@ AT_DATA([prog.cob], [
STOP RUN.
])
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
-
-AT_CLEANUP
-
-
-# Invalid test.
-# prog.cob:18: ANY LENGTH valid only for 01 in LIKAGE SECTION of a contained program
-# "subprog", so called, is not contained.
-
-AT_SETUP([FUNCTION as CALL parameter BY CONTENT])
-AT_KEYWORDS([functions])
-
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
-
- PROCEDURE DIVISION.
- PROG-MAIN.
- CALL "subprog" USING BY CONTENT
- FUNCTION CONCAT("Abc" "D")
- STOP RUN.
-
- *> *****************************
- IDENTIFICATION DIVISION.
- PROGRAM-ID. subprog.
-
- DATA DIVISION.
- LINKAGE SECTION.
- 01 TESTING PIC X ANY LENGTH.
-
- PROCEDURE DIVISION USING TESTING.
- SUBPROG-MAIN.
- DISPLAY TESTING
- GOBACK.
- END PROGRAM subprog.
- END PROGRAM prog. *> bzzt
-])
-
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [AbcD
-], [])
-
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION COS])
-AT_KEYWORDS([functions])
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 Y PIC S9V9(33).
- PROCEDURE DIVISION.
- MOVE FUNCTION COS ( -0.2345 ) TO Y.
- IF Y NOT = 0.972630641256258184713416962414561
- DISPLAY Y
- END-DISPLAY
- END-IF.
- STOP RUN.
-])
AT_CHECK([$COMPILE prog.cob], [0], [], [])
AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
AT_CLEANUP
@@ -482,3396 +151,308 @@ AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [OK], [])
AT_CLEANUP
-AT_SETUP([FUNCTION CURRENT-DATE])
+AT_SETUP([FUNCTION MODULE-CALLER-ID])
AT_KEYWORDS([functions])
+AT_XFAIL_IF([test "$COB_DIALECT" != "gnu"])
+AT_XFAIL_IF([test "$COB_DIALECT" != "gnu"])
+
AT_DATA([prog.cob], [
IDENTIFICATION DIVISION.
PROGRAM-ID. prog.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
- 01 TEST-FLD.
- 02 WS-YEAR PIC 9(04).
- 88 VALID-YEAR VALUE 1980 THRU 9999.
- 02 WS-MONTH PIC 9(02).
- 88 VALID-MONTH VALUE 01 THRU 12.
- 02 WS-DAY PIC 9(02).
- 88 VALID-DAY VALUE 01 THRU 31.
- 02 WS-HOUR PIC 9(02).
- 88 VALID-HOUR VALUE 00 THRU 23.
- 02 WS-MIN PIC 9(02).
- 88 VALID-MIN VALUE 00 THRU 59.
- 02 WS-SEVALIDD PIC 9(02).
- 88 VALID-SEC VALUE 00 THRU 59.
- 02 WS-HUNDSEC PIC 9(02).
- 88 VALID-HUNDSEC VALUE 00 THRU 99.
- 02 WS-GREENW PIC X.
- 88 VALID-GREENW VALUE "-", "+", "0".
- 88 ZERO-GREENW VALUE "0".
- 02 WS-OFFSET PIC 9(02).
- 88 VALID-OFFSET VALUE 00 THRU 13.
- 88 ZERO-OFFSET VALUE 00.
- 02 WS-OFFSET2 PIC 9(02).
- 88 VALID-OFFSET2 VALUE 00 THRU 59.
- 88 ZERO-OFFSET2 VALUE 00.
- 02 WS-UNSET PIC X VALUE '_'.
- 88 VALID-UNSET VALUE '_'.
PROCEDURE DIVISION.
- STRING FUNCTION CURRENT-DATE
- DELIMITED BY SIZE
- INTO TEST-FLD
- END-STRING.
- EVALUATE TRUE
- WHEN NOT VALID-UNSET
- DISPLAY "FUNCTION result too long"
- END-DISPLAY
- WHEN VALID-YEAR AND
- VALID-MONTH AND
- VALID-DAY AND
- VALID-HOUR AND
- VALID-MIN AND
- VALID-SEC AND
- VALID-HUNDSEC AND
- VALID-GREENW AND
- VALID-OFFSET AND
- VALID-OFFSET2 AND
- VALID-UNSET AND
- ((NOT ZERO-GREENW) OR (ZERO-OFFSET AND ZERO-OFFSET2))
- CONTINUE
- WHEN OTHER
- DISPLAY "CURRENT-DATE with wrong format: "
- TEST-FLD (01:21)
- END-DISPLAY
- END-EVALUATE.
+ CALL "prog2"
+ END-CALL.
STOP RUN.
])
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION DATE-OF-INTEGER])
-AT_KEYWORDS([functions])
-AT_DATA([prog.cob], [
+AT_DATA([prog2.cob], [
IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
+ PROGRAM-ID. prog2.
+ ENVIRONMENT DIVISION.
DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 TEST-FLD PIC S9(09)V9(02).
+ WORKING-STORAGE SECTION.
PROCEDURE DIVISION.
- MOVE FUNCTION DATE-OF-INTEGER ( 146000 )
- TO TEST-FLD.
- IF TEST-FLD NOT = 20000925
- DISPLAY TEST-FLD
- END-DISPLAY
- END-IF.
- STOP RUN.
+ DISPLAY FUNCTION MODULE-CALLER-ID NO ADVANCING
+ END-DISPLAY.
+ EXIT PROGRAM.
])
AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+AT_CHECK([$COMPILE_MODULE prog2.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [prog])
AT_CLEANUP
-AT_SETUP([FUNCTION DATE-TO-YYYYMMDD])
+AT_SETUP([FUNCTION MODULE-DATE])
AT_KEYWORDS([functions])
+AT_XFAIL_IF([test "$COB_DIALECT" != "gnu"])
AT_DATA([prog.cob], [
IDENTIFICATION DIVISION.
PROGRAM-ID. prog.
+ ENVIRONMENT DIVISION.
DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 TEST-FLD PIC S9(09)V9(02).
+ WORKING-STORAGE SECTION.
+ 01 TEST-DATE PIC 9(8) VALUE 0.
PROCEDURE DIVISION.
- MOVE FUNCTION DATE-TO-YYYYMMDD ( 981002, -10, 1994 )
- TO TEST-FLD.
- IF TEST-FLD NOT = 018981002
- DISPLAY TEST-FLD
- END-DISPLAY
+ MOVE FUNCTION MODULE-DATE TO TEST-DATE.
+ IF TEST-DATE NOT = 0
+ DISPLAY "OK" NO ADVANCING
+ END-DISPLAY
END-IF.
STOP RUN.
])
AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [OK], [])
AT_CLEANUP
-AT_SETUP([FUNCTION DAY-OF-INTEGER])
+AT_SETUP([FUNCTION MODULE-FORMATTED-DATE])
AT_KEYWORDS([functions])
+AT_XFAIL_IF([test "$COB_DIALECT" != "gnu"])
AT_DATA([prog.cob], [
IDENTIFICATION DIVISION.
PROGRAM-ID. prog.
+ ENVIRONMENT DIVISION.
DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 TEST-FLD PIC S9(09)V9(02).
- PROCEDURE DIVISION.
- MOVE FUNCTION DAY-OF-INTEGER ( 146000 )
- TO TEST-FLD.
- IF TEST-FLD NOT = 2000269
- DISPLAY TEST-FLD
- END-DISPLAY
- END-IF.
- STOP RUN.
-])
-
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
-
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION DAY-TO-YYYYDDD])
-AT_KEYWORDS([functions])
-
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 TEST-FLD PIC S9(09)V9(02).
+ WORKING-STORAGE SECTION.
+ 01 TEST-DATE PIC X(16) VALUE SPACES.
PROCEDURE DIVISION.
- MOVE FUNCTION DAY-TO-YYYYDDD ( 95005, -10, 2013 )
- TO TEST-FLD.
- IF TEST-FLD NOT = 001995005
- DISPLAY TEST-FLD
- END-DISPLAY
+ MOVE FUNCTION MODULE-FORMATTED-DATE TO TEST-DATE.
+ IF TEST-DATE NOT = SPACES
+ DISPLAY "OK" NO ADVANCING
+ END-DISPLAY
END-IF.
STOP RUN.
])
AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [OK], [])
AT_CLEANUP
-AT_SETUP([FUNCTION E])
+AT_SETUP([FUNCTION MODULE-ID])
AT_KEYWORDS([functions])
+AT_XFAIL_IF([test "$COB_DIALECT" != "gnu"])
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 Y PIC 9V9(33).
- PROCEDURE DIVISION.
- MOVE FUNCTION E TO Y.
- IF Y NOT = 2.718281828459045235360287471352662
- DISPLAY Y
- END-DISPLAY
- END-IF.
- STOP RUN.
-])
-
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION EXCEPTION-FILE])
-AT_KEYWORDS([functions exceptions])
AT_DATA([prog.cob], [
IDENTIFICATION DIVISION.
PROGRAM-ID. prog.
ENVIRONMENT DIVISION.
- INPUT-OUTPUT SECTION.
- FILE-CONTROL.
- SELECT TEST-FILE ASSIGN "NOTEXIST"
- FILE STATUS IS TEST-STATUS.
DATA DIVISION.
- FILE SECTION.
- FD TEST-FILE.
- 01 TEST-REC PIC X(4).
WORKING-STORAGE SECTION.
- 01 TEST-STATUS PIC XX.
PROCEDURE DIVISION.
- DISPLAY FUNCTION EXCEPTION-FILE '|'
- NO ADVANCING
- END-DISPLAY.
- OPEN INPUT TEST-FILE.
- DISPLAY FUNCTION EXCEPTION-FILE
- NO ADVANCING
+ DISPLAY FUNCTION MODULE-ID NO ADVANCING
END-DISPLAY.
STOP RUN.
])
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0],
-[00|35TEST-FILE], [])
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION EXCEPTION-LOCATION])
-AT_KEYWORDS([functions exceptions])
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- ENVIRONMENT DIVISION.
- INPUT-OUTPUT SECTION.
- FILE-CONTROL.
- SELECT TEST-FILE ASSIGN "NOTEXIST"
- FILE STATUS IS TEST-STATUS.
- DATA DIVISION.
- FILE SECTION.
- FD TEST-FILE.
- 01 TEST-REC PIC X(4).
- WORKING-STORAGE SECTION.
- 01 TEST-STATUS PIC XX.
- PROCEDURE DIVISION.
- DECLARATIVES.
- EC-ALL-SECTION SECTION.
- USE EC EC-ALL
- RESUME NEXT STATEMENT.
- END DECLARATIVES.
- A00-MAIN SECTION.
- A00.
- SET LAST EXCEPTION TO OFF
- DISPLAY "EXCEPTION-LOCATION before open attempt: "
- """" FUNCTION EXCEPTION-LOCATION """".
- B00-MAIN SECTION.
- B00.
- SET LAST EXCEPTION TO OFF
- OPEN INPUT TEST-FILE.
- DISPLAY "EXCEPTION-LOCATION after open attempt: "
- """" FUNCTION EXCEPTION-LOCATION """".
- C00-MAIN SECTION.
- C00.
- >>TURN EC-ALL CHECKING ON
- SET LAST EXCEPTION TO OFF
- OPEN INPUT TEST-FILE.
- DISPLAY "EXCEPTION-LOCATION after CHECKED open attempt: "
- """" FUNCTION EXCEPTION-LOCATION """".
- STOP RUN.
-])
AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0],
-[EXCEPTION-LOCATION before open attempt: " "
-EXCEPTION-LOCATION after open attempt: "prog; B00 OF B00-MAIN; prog.cob:29 "
-EXCEPTION-LOCATION after CHECKED open attempt: "prog; C00 OF C00-MAIN; prog.cob:36 "
-], [])
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION EXCEPTION-STATEMENT])
-AT_KEYWORDS([functions exceptions])
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- ENVIRONMENT DIVISION.
- INPUT-OUTPUT SECTION.
- FILE-CONTROL.
- SELECT TEST-FILE ASSIGN "NOTEXIST"
- FILE STATUS IS TEST-STATUS.
- DATA DIVISION.
- FILE SECTION.
- FD TEST-FILE.
- 01 TEST-REC PIC X(4).
- WORKING-STORAGE SECTION.
- 01 TEST-STATUS PIC XX.
- PROCEDURE DIVISION.
- DISPLAY "EXCEPTION-STATEMENT before bad OPEN: "
- """" FUNCTION EXCEPTION-STATEMENT """"
- OPEN INPUT TEST-FILE.
- DISPLAY "EXCEPTION-STATEMENT after bad OPEN: "
- """" FUNCTION EXCEPTION-STATEMENT """"
- STOP RUN.
-])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [prog])
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0],
-[EXCEPTION-STATEMENT before bad OPEN: " "
-EXCEPTION-STATEMENT after bad OPEN: "OPEN"
-], [])
AT_CLEANUP
-AT_SETUP([FUNCTION EXCEPTION-STATUS])
-AT_KEYWORDS([functions exceptions])
+AT_SETUP([FUNCTION MODULE-PATH])
+AT_KEYWORDS([functions])
+AT_XFAIL_IF([test "$COB_DIALECT" != "gnu"])
+
AT_DATA([prog.cob], [
IDENTIFICATION DIVISION.
PROGRAM-ID. prog.
ENVIRONMENT DIVISION.
- INPUT-OUTPUT SECTION.
- FILE-CONTROL.
- SELECT TEST-FILE ASSIGN "NOTEXIST"
- FILE STATUS IS TEST-STATUS.
DATA DIVISION.
- FILE SECTION.
- FD TEST-FILE.
- 01 TEST-REC PIC X(4).
WORKING-STORAGE SECTION.
- 01 TEST-STATUS PIC XX.
- PROCEDURE DIVISION.
- DISPLAY "EXCEPTION STATUS before bad open: "
- """" FUNCTION EXCEPTION-STATUS """"
- OPEN INPUT TEST-FILE.
- DISPLAY "EXCEPTION STATUS after bad open: "
- """" FUNCTION EXCEPTION-STATUS """"
- STOP RUN.
-])
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0],
-[EXCEPTION STATUS before bad open: " "
-EXCEPTION STATUS after bad open: "EC-I-O-PERMANENT-ERROR"
-], [])
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION EXP])
-AT_KEYWORDS([functions])
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 Y PIC S99V9(31).
+ 01 TEST-PATH PIC X(16) VALUE SPACES.
PROCEDURE DIVISION.
- MOVE FUNCTION EXP ( 3 ) TO Y.
- IF Y NOT = 20.0855369231876677409285296545817
- DISPLAY Y
- END-DISPLAY
+ MOVE FUNCTION MODULE-PATH TO TEST-PATH.
+ IF TEST-PATH NOT = SPACES
+ DISPLAY "OK" NO ADVANCING
+ END-DISPLAY
END-IF.
STOP RUN.
])
+
AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [OK], [])
+
AT_CLEANUP
-AT_SETUP([FUNCTION EXP10])
+AT_SETUP([FUNCTION MODULE-SOURCE])
AT_KEYWORDS([functions])
+AT_XFAIL_IF([test "$COB_DIALECT" != "gnu"])
AT_DATA([prog.cob], [
IDENTIFICATION DIVISION.
PROGRAM-ID. prog.
+ ENVIRONMENT DIVISION.
DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 TEST-FLD PIC S9(09)V9(02).
+ WORKING-STORAGE SECTION.
PROCEDURE DIVISION.
- MOVE FUNCTION EXP10 ( 4 )
- TO TEST-FLD.
- IF TEST-FLD NOT = 000010000
- DISPLAY TEST-FLD
- END-DISPLAY
- END-IF.
+ DISPLAY FUNCTION MODULE-SOURCE NO ADVANCING
+ END-DISPLAY.
STOP RUN.
])
AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [prog.cob])
AT_CLEANUP
-AT_SETUP([FUNCTION FACTORIAL])
+AT_SETUP([FUNCTION MODULE-TIME])
AT_KEYWORDS([functions])
+AT_XFAIL_IF([test "$COB_DIALECT" != "gnu"])
AT_DATA([prog.cob], [
IDENTIFICATION DIVISION.
PROGRAM-ID. prog.
+ ENVIRONMENT DIVISION.
DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 TEST-FLD PIC S9(09)V9(02).
+ WORKING-STORAGE SECTION.
+ 01 TEST-TIME PIC 9(6) VALUE 0.
PROCEDURE DIVISION.
- MOVE FUNCTION FACTORIAL ( 6 )
- TO TEST-FLD.
- IF TEST-FLD NOT = 000000720
- DISPLAY TEST-FLD
- END-DISPLAY
+ MOVE FUNCTION MODULE-TIME TO TEST-TIME.
+ IF TEST-TIME NOT = 0
+ DISPLAY "OK" NO ADVANCING
+ END-DISPLAY
END-IF.
STOP RUN.
])
AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [OK], [])
AT_CLEANUP
-AT_SETUP([FUNCTION FORMATTED-CURRENT-DATE])
+AT_SETUP([FUNCTION MONETARY-DECIMAL-POINT])
AT_KEYWORDS([functions])
+AT_XFAIL_IF([test "$COB_DIALECT" != "gnu"])
AT_DATA([prog.cob], [
IDENTIFICATION DIVISION.
PROGRAM-ID. prog.
+ ENVIRONMENT DIVISION.
DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 Datetime-Format CONSTANT "YYYYMMDDThhmmss.ss+hhmm".
- 01 str PIC X(25).
+ WORKING-STORAGE SECTION.
+ 01 TEST-FLD PIC X(8) VALUE SPACES.
PROCEDURE DIVISION.
- *> Test normal inputs.
- MOVE FUNCTION FORMATTED-CURRENT-DATE ( Datetime-Format )
- TO str
- IF FUNCTION TEST-FORMATTED-DATETIME ( Datetime-Format, str)
- <> 0
- DISPLAY "Test 1 failed: " str END-DISPLAY
- END-IF.
-
+ MOVE FUNCTION MONETARY-DECIMAL-POINT TO TEST-FLD.
+ DISPLAY "OK" NO ADVANCING
+ END-DISPLAY
STOP RUN.
])
AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [OK], [])
AT_CLEANUP
-AT_SETUP([FUNCTION FORMATTED-DATE])
+AT_SETUP([FUNCTION MONETARY-THOUSANDS-SEPARATOR])
AT_KEYWORDS([functions])
+AT_XFAIL_IF([test "$COB_DIALECT" != "gnu"])
AT_DATA([prog.cob], [
IDENTIFICATION DIVISION.
PROGRAM-ID. prog.
+ ENVIRONMENT DIVISION.
DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 str PIC X(10).
+ WORKING-STORAGE SECTION.
+ 01 TEST-FLD PIC X(8) VALUE SPACES.
PROCEDURE DIVISION.
- *> Test normal inputs.
- MOVE FUNCTION FORMATTED-DATE ( "YYYYMMDD", 1 ) TO str
- IF str <> "16010101"
- DISPLAY "Test 1 failed: " str END-DISPLAY
- END-IF
-
- MOVE FUNCTION FORMATTED-DATE ( "YYYY-MM-DD", 1 ) TO str
- IF str <> "1601-01-01"
- DISPLAY "Test 2 failed: " str END-DISPLAY
- END-IF
-
- MOVE FUNCTION FORMATTED-DATE ( "YYYYDDD", 1 ) TO str
- IF str <> "1601001"
- DISPLAY "Test 3 failed: " str END-DISPLAY
- END-IF
-
- MOVE FUNCTION FORMATTED-DATE ( "YYYY-DDD", 1 ) TO str
- IF str <> "1601-001"
- DISPLAY "Test 4 failed: " str END-DISPLAY
- END-IF
-
- MOVE FUNCTION FORMATTED-DATE ( "YYYYWwwD", 1 ) TO str
- IF str <> "1601W011"
- DISPLAY "Test 5 failed: " str END-DISPLAY
- END-IF
-
- MOVE FUNCTION FORMATTED-DATE ( "YYYY-Www-D", 1 ) TO str
- IF str <> "1601-W01-1"
- DISPLAY "Test 6 failed: " str END-DISPLAY
- END-IF
-
- *> Test week number edge cases.
- *> For 2012-01-01.
- MOVE FUNCTION FORMATTED-DATE ( "YYYYWwwD", 150115 ) TO str
- IF str <> "2011W527"
- DISPLAY "Test 7 failed: " str END-DISPLAY
- END-IF
-
- *> and for 2013-12-30.
- MOVE FUNCTION FORMATTED-DATE ( "YYYYWwwD", 150844 ) TO str
- IF str <> "2014W011"
- DISPLAY "Test 8 failed: " str END-DISPLAY
- END-IF
-
+ MOVE FUNCTION MONETARY-THOUSANDS-SEPARATOR TO TEST-FLD.
+ DISPLAY "OK" NO ADVANCING
+ END-DISPLAY
STOP RUN.
])
AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [OK], [])
AT_CLEANUP
-AT_SETUP([FUNCTION FORMATTED-DATE with ref modding])
+AT_SETUP([FUNCTION NUMERIC-DECIMAL-POINT])
AT_KEYWORDS([functions])
+AT_XFAIL_IF([test "$COB_DIALECT" != "gnu"])
AT_DATA([prog.cob], [
IDENTIFICATION DIVISION.
PROGRAM-ID. prog.
+ ENVIRONMENT DIVISION.
DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 str PIC X(04).
+ WORKING-STORAGE SECTION.
+ 01 TEST-FLD PIC X(8) VALUE SPACES.
PROCEDURE DIVISION.
- MOVE FUNCTION FORMATTED-DATE ("YYYYMMDD", 1) (3:4)
- TO STR
- IF STR NOT = '0101'
- DISPLAY STR
- END-DISPLAY
- END-IF
+ MOVE FUNCTION NUMERIC-DECIMAL-POINT TO TEST-FLD.
+ DISPLAY "OK" NO ADVANCING
+ END-DISPLAY
STOP RUN.
])
AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [OK], [])
AT_CLEANUP
-AT_SETUP([FUNCTION FORMATTED-DATETIME])
+AT_SETUP([FUNCTION NUMERIC-THOUSANDS-SEPARATOR])
AT_KEYWORDS([functions])
+AT_XFAIL_IF([test "$COB_DIALECT" != "gnu"])
AT_DATA([prog.cob], [
IDENTIFICATION DIVISION.
PROGRAM-ID. prog.
+ ENVIRONMENT DIVISION.
DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 str PIC X(40).
+ WORKING-STORAGE SECTION.
+ 01 TEST-FLD PIC X(8) VALUE SPACES.
PROCEDURE DIVISION.
- *> Test normal inputs.
- MOVE FUNCTION FORMATTED-DATETIME
- ("YYYYMMDDThhmmss", 1, 45296)
- TO str
- IF str <> "16010101T123456"
- DISPLAY "Test 1 failed: " str END-DISPLAY
- END-IF
-
- MOVE FUNCTION FORMATTED-DATETIME
- ("YYYY-MM-DDThh:mm:ss", 1, 45296)
- TO str
- IF str <> "1601-01-01T12:34:56"
- DISPLAY "Test 2 failed: " str END-DISPLAY
- END-IF
-
- MOVE FUNCTION FORMATTED-DATETIME
- ("YYYYDDDThhmmss+hhmm", 1, 45296, -754)
- TO str
- IF str <> "1601001T123456-1234"
- DISPLAY "Test 3 failed: " str END-DISPLAY
- END-IF
-
- MOVE FUNCTION FORMATTED-DATETIME
- ("YYYYDDDThhmmss+hhmm", 1, 45296)
- TO str
- IF str <> "1601001T123456+0000"
- DISPLAY "Test 4 failed: " str END-DISPLAY
- END-IF
-
- *> Test underflow to next day due to offset
- MOVE FUNCTION FORMATTED-DATETIME
- ("YYYYDDDThhmmss.sssssssssZ", 150846, 0,
- 1)
- TO str
- IF str <> "2013365T235900.000000000Z"
- DISPLAY "Test 5 failed: " str END-DISPLAY
- END-IF
-
+ MOVE FUNCTION NUMERIC-THOUSANDS-SEPARATOR TO TEST-FLD.
+ DISPLAY "OK" NO ADVANCING
+ END-DISPLAY
STOP RUN.
])
AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [OK], [])
AT_CLEANUP
-AT_SETUP([FUNCTION FORMATTED-DATETIME with ref modding])
+AT_SETUP([FUNCTION STORED-CHAR-LENGTH])
AT_KEYWORDS([functions])
+AT_XFAIL_IF([test "$COB_DIALECT" != "gnu"])
AT_DATA([prog.cob], [
IDENTIFICATION DIVISION.
PROGRAM-ID. prog.
DATA DIVISION.
WORKING-STORAGE SECTION.
- 01 str PIC X(04).
+ 01 Y PIC X(24).
+ 01 Z USAGE BINARY-LONG.
PROCEDURE DIVISION.
- MOVE FUNCTION FORMATTED-DATETIME
- ("YYYYMMDDThhmmss", 1, 1) (3:4)
- TO STR
- IF STR NOT = '0101'
- DISPLAY STR
+ MOVE "123456789012" TO Y.
+ MOVE FUNCTION STORED-CHAR-LENGTH ( Y ) TO Z.
+ IF Z NOT = 12
+ DISPLAY Z
END-DISPLAY
- END-IF
+ END-IF.
STOP RUN.
])
-
AT_CHECK([$COMPILE prog.cob], [0], [], [])
AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
-
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION FORMATTED-TIME])
-AT_KEYWORDS([functions])
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 str PIC X(20).
- PROCEDURE DIVISION.
- *> Test normal inputs.
- MOVE FUNCTION FORMATTED-TIME ( "hhmmss", 45296 ) TO str
- IF str <> "123456"
- DISPLAY "Test 1 failed: " str END-DISPLAY
- END-IF
-
- MOVE FUNCTION FORMATTED-TIME ( "hh:mm:ss", 45296 ) TO str
- IF str <> "12:34:56"
- DISPLAY "Test 2 failed: " str END-DISPLAY
- END-IF
-
- MOVE FUNCTION FORMATTED-TIME ( "hhmmssZ", 86399, -1 ) TO str
- IF str <> "000059Z"
- DISPLAY "Test 3 failed: " str END-DISPLAY
- END-IF
-
- MOVE FUNCTION FORMATTED-TIME ( "hh:mm:ssZ", 45296)
- TO str
- IF str <> "12:34:56Z"
- DISPLAY "Test 4 failed: " str END-DISPLAY
- END-IF
-
- MOVE FUNCTION FORMATTED-TIME ( "hhmmss.ss", 45296.78 ) TO str
- IF str <> "123456.78"
- DISPLAY "Test 5 failed: " str END-DISPLAY
- END-IF
-
- MOVE FUNCTION FORMATTED-TIME ( "hh:mm:ss.ssZ", 0, 120)
- TO str
- IF str <> "22:00:00.00Z"
- DISPLAY "Test 6 failed: " str END-DISPLAY
- END-IF
-
- MOVE FUNCTION FORMATTED-TIME ( "hhmmss+hhmm", 45296)
- TO str
- IF str <> "123456+0000"
- DISPLAY "Test 7 failed: " str END-DISPLAY
- END-IF
-
- MOVE FUNCTION FORMATTED-TIME ( "hh:mm:ss+hh:mm", 45296, 0 )
- TO str
- IF str <> "12:34:56+00:00"
- DISPLAY "Test 8 failed: " str END-DISPLAY
- END-IF
-
- MOVE FUNCTION FORMATTED-TIME ( "hhmmss+hhmm", 45296, -754)
- TO str
- IF str <> "123456-1234"
- DISPLAY "Test 9 failed: " str END-DISPLAY
- END-IF
-
- *> Test with invalid/missing offset times.
- MOVE FUNCTION FORMATTED-TIME ( "hhmmss+hhmm", 1, 3000 )
- TO str
- DISPLAY "Test 10 " """" str """"
- DISPLAY "Test 10 " """" FUNCTION EXCEPTION-STATUS """"
- DISPLAY "Test 10 " """" FUNCTION EXCEPTION-LOCATION """"
-
- MOVE FUNCTION FORMATTED-TIME ( "hhmmss+hhmm", 1, -3000 )
- TO str
- DISPLAY "Test 11 " """" str """"
- DISPLAY "Test 11 " """" FUNCTION EXCEPTION-STATUS """"
- DISPLAY "Test 11 " """" FUNCTION EXCEPTION-LOCATION """"
-
- STOP RUN.
-])
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [Test 10 " "
-Test 10 "EC-ARGUMENT-FUNCTION"
-Test 10 "prog; ; prog.cob:60 "
-Test 11 " "
-Test 11 "EC-ARGUMENT-FUNCTION"
-Test 11 "prog; ; prog.cob:66 "
-], [])
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION FORMATTED-TIME DP.COMMA])
-AT_KEYWORDS([functions])
-
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
-
- ENVIRONMENT DIVISION.
- CONFIGURATION SECTION.
- SPECIAL-NAMES.
- DECIMAL-POINT IS COMMA.
-
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 str PIC X(11).
-
- PROCEDURE DIVISION.
- MOVE FUNCTION FORMATTED-TIME ("hh:mm:ss,ss", 45296) TO str
- IF str <> "12:34:56,00"
- DISPLAY "Test 1 failed: " str END-DISPLAY
- END-IF
-
- STOP RUN.
-])
-
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
-
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION FORMATTED-TIME with ref modding])
-AT_KEYWORDS([functions])
-
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 str PIC X(04).
- PROCEDURE DIVISION.
- MOVE FUNCTION FORMATTED-TIME ("hhmmss", 45296) (3:4)
- TO STR
- IF STR NOT = '3456'
- DISPLAY STR
- END-DISPLAY
- END-IF
- STOP RUN.
-])
-
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
-
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION FRACTION-PART])
-AT_KEYWORDS([functions])
-
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 TEST-FLD PIC S9(04)V9(04).
- PROCEDURE DIVISION.
- MOVE FUNCTION FRACTION-PART ( 3.12345 )
- TO TEST-FLD.
- IF TEST-FLD NOT = +0000.1234
- DISPLAY 'FRACTION-PART ( +3.12345 ) wrong: ' TEST-FLD
- END-DISPLAY
- END-IF.
- MOVE FUNCTION FRACTION-PART ( -3.12345 )
- TO TEST-FLD.
- IF TEST-FLD NOT = -0000.1234
- DISPLAY 'FRACTION-PART ( -3.12345 ) wrong: ' TEST-FLD
- END-DISPLAY
- END-IF.
- STOP RUN.
-])
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
-AT_CLEANUP
-
-AT_SETUP([FUNCTION HEX-OF])
-AT_KEYWORDS([functions])
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 PAC PIC 9(5) COMP-3 VALUE 12345.
- PROCEDURE DIVISION.
- DISPLAY FUNCTION HEX-OF('Hello, world!')
- DISPLAY FUNCTION HEX-OF(PAC)
- END PROGRAM prog.
-])
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [48656C6C6F2C20776F726C6421
-12345F
-], [])
-AT_CLEANUP
-
-AT_SETUP([FUNCTION HIGHEST-ALGEBRAIC])
-AT_KEYWORDS([functions])
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 F1 PIC S999.
- 01 F2 PIC S9(4) BINARY.
- 01 F3 PIC 99V9(3).
- 01 F4 PIC $**,**9.99BCR.
- 01 F5 PIC $**,**9.99.
- 01 F6 USAGE BINARY-CHAR SIGNED.
- 01 F7 USAGE BINARY-CHAR UNSIGNED.
- 01 F8 PIC 999PPP.
- 01 F9 PIC P99.
- 01 TEST-FLD PIC S9(08)V9(04).
- PROCEDURE DIVISION.
- MOVE FUNCTION HIGHEST-ALGEBRAIC (F1)
- TO TEST-FLD.
- IF TEST-FLD NOT = 999
- DISPLAY "Test 1 fail: " TEST-FLD
- END-DISPLAY
- END-IF.
- MOVE FUNCTION HIGHEST-ALGEBRAIC (F2)
- TO TEST-FLD.
- IF TEST-FLD NOT = 9999
- DISPLAY "Test 2 fail: " TEST-FLD
- END-DISPLAY
- END-IF.
- MOVE FUNCTION HIGHEST-ALGEBRAIC (F3)
- TO TEST-FLD.
- IF TEST-FLD NOT = 99.999
- DISPLAY "Test 3 fail: " TEST-FLD
- END-DISPLAY
- END-IF.
- MOVE FUNCTION HIGHEST-ALGEBRAIC (F4)
- TO TEST-FLD.
- IF TEST-FLD NOT = 99999.99
- DISPLAY "Test 4 fail: " TEST-FLD
- END-DISPLAY
- END-IF.
- MOVE FUNCTION HIGHEST-ALGEBRAIC (F5)
- TO TEST-FLD.
- IF TEST-FLD NOT = 99999.99
- DISPLAY "Test 5 fail: " TEST-FLD
- END-DISPLAY
- END-IF.
- MOVE FUNCTION HIGHEST-ALGEBRAIC (F6)
- TO TEST-FLD.
- IF TEST-FLD NOT = 127
- DISPLAY "Test 6 fail: " TEST-FLD
- END-DISPLAY
- END-IF.
- MOVE FUNCTION HIGHEST-ALGEBRAIC (F7)
- TO TEST-FLD.
- IF TEST-FLD NOT = 255
- DISPLAY "Test 7 fail: " TEST-FLD
- END-DISPLAY
- END-IF.
-
- MOVE FUNCTION HIGHEST-ALGEBRAIC (F8)
- TO TEST-FLD.
- IF TEST-FLD NOT = 999000
- DISPLAY "Test 7 fail: " TEST-FLD
- END-DISPLAY
- END-IF.
-
- MOVE FUNCTION HIGHEST-ALGEBRAIC (F9)
- TO TEST-FLD.
- IF TEST-FLD NOT = 0.099
- DISPLAY "Test 7 fail: " TEST-FLD
- END-DISPLAY
- END-IF.
-
- STOP RUN.
-])
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
-AT_CLEANUP
-
-AT_SETUP([FUNCTION INTEGER])
-AT_KEYWORDS([functions])
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 X PIC S9(4)V9(4) VALUE -1.5.
- 01 Y PIC 9(12) VALUE 600851475143.
- 01 TEST-FLD PIC S9(14)V9(08).
- PROCEDURE DIVISION.
- MOVE FUNCTION INTEGER ( X )
- TO TEST-FLD.
- IF TEST-FLD NOT = -2
- DISPLAY 'INTEGER ( X ) wrong: ' TEST-FLD
- END-DISPLAY
- END-IF.
- MOVE FUNCTION INTEGER ( Y / 71 )
- TO TEST-FLD.
- IF TEST-FLD NOT = 8462696833
- DISPLAY 'INTEGER ( Y / 71 ) wrong: ' TEST-FLD
- END-DISPLAY
- END-IF.
- STOP RUN.
-])
-
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
-
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION INTEGER-OF-DATE])
-AT_KEYWORDS([functions])
-
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 TEST-FLD PIC S9(09)V9(02).
- PROCEDURE DIVISION.
- MOVE FUNCTION INTEGER-OF-DATE ( 20000925 )
- TO TEST-FLD.
- IF TEST-FLD NOT = 000146000
- DISPLAY TEST-FLD
- END-DISPLAY
- END-IF.
- STOP RUN.
-])
-
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
-
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION INTEGER-OF-DAY])
-AT_KEYWORDS([functions])
-
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 TEST-FLD PIC S9(09)V9(02).
- PROCEDURE DIVISION.
- MOVE FUNCTION INTEGER-OF-DAY ( 2000269 )
- TO TEST-FLD.
- IF TEST-FLD NOT = 000146000
- DISPLAY TEST-FLD
- END-DISPLAY
- END-IF.
- STOP RUN.
-])
-
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
-
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION INTEGER-OF-FORMATTED-DATE])
-AT_KEYWORDS([functions])
-
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 day-int PIC 9(9).
-
- PROCEDURE DIVISION.
- *> The date 2013-12-30 is used as it can also be used to
- *> check the conversion of dates in week form.
- MOVE FUNCTION INTEGER-OF-FORMATTED-DATE
- ("YYYY-MM-DD", "2013-12-30")
- TO day-int
- IF day-int <> 150844
- DISPLAY "Test 1 failed: " day-int END-DISPLAY
- END-IF
-
- MOVE FUNCTION INTEGER-OF-FORMATTED-DATE
- ("YYYY-DDD", "2013-364")
- TO day-int
- IF day-int <> 150844
- DISPLAY "Test 2 failed: " day-int END-DISPLAY
- END-IF
-
- MOVE FUNCTION INTEGER-OF-FORMATTED-DATE
- ("YYYY-Www-D", "2014-W01-1")
- TO day-int
- IF day-int <> 150844
- DISPLAY "Test 3 failed: " day-int END-DISPLAY
- END-IF
-
- MOVE FUNCTION INTEGER-OF-FORMATTED-DATE
- ("YYYY-MM-DDThh:mm:ss", "2013-12-30T12:34:56")
- TO day-int
- IF day-int <> 150844
- DISPLAY "Test 4 failed: " day-int END-DISPLAY
- END-IF
-
- STOP RUN.
-])
-
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
-
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION INTEGER-PART])
-AT_KEYWORDS([functions])
-
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 X PIC S9(4)V9(4) VALUE -1.5.
- 01 TEST-FLD PIC S9(04)V9(02).
- PROCEDURE DIVISION.
- MOVE FUNCTION INTEGER-PART ( X )
- TO TEST-FLD.
- IF TEST-FLD NOT = -1
- DISPLAY TEST-FLD
- END-DISPLAY
- END-IF.
- STOP RUN.
-])
-
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
-
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION LENGTH])
-AT_KEYWORDS([functions])
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 X PIC S9(4)V9(4) VALUE -1.5.
- 01 TEST-FLD PIC S9(04)V9(02).
- PROCEDURE DIVISION.
- MOVE FUNCTION LENGTH ( X ) TO TEST-FLD
- IF TEST-FLD NOT = 8
- DISPLAY 'LENGTH "00128" wrong: ' TEST-FLD
- END-DISPLAY
- END-IF
-
- MOVE FUNCTION LENGTH ( '00128' )
- TO TEST-FLD
- IF TEST-FLD NOT = 5
- DISPLAY 'LENGTH "00128" wrong: ' TEST-FLD
- END-DISPLAY
- END-IF
-
- MOVE FUNCTION LENGTH ( x'a0' )
- TO TEST-FLD
- IF TEST-FLD NOT = 1
- DISPLAY 'LENGTH x"a0" wrong: ' TEST-FLD
- END-DISPLAY
- END-IF
-
- MOVE FUNCTION LENGTH ( z'a0' )
- TO TEST-FLD
- IF TEST-FLD NOT = 3
- DISPLAY 'LENGTH z"a0" wrong: ' TEST-FLD
- END-DISPLAY
- END-IF
-
- STOP RUN.
-])
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION LOCALE-COMPARE])
-AT_KEYWORDS([functions])
-
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- PROCEDURE DIVISION.
- IF FUNCTION LOCALE-COMPARE ("A", "B") NOT = "<"
- DISPLAY "Test 1 fail"
- END-DISPLAY
- END-IF.
- IF FUNCTION LOCALE-COMPARE ("B", "A") NOT = ">"
- DISPLAY "Test 2 fail"
- END-DISPLAY
- END-IF.
- IF FUNCTION LOCALE-COMPARE ("A", "A") NOT = "="
- DISPLAY "Test 3 fail"
- END-DISPLAY
- END-IF.
- STOP RUN.
-])
-
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
-
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION LOCALE-DATE])
-AT_KEYWORDS([functions])
-
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 X PIC X(32) VALUE SPACES.
- PROCEDURE DIVISION.
- MOVE FUNCTION LOCALE-DATE ( "19630302" ) TO X.
- IF X NOT = SPACES
- DISPLAY "OK"
- END-DISPLAY
- END-IF.
- STOP RUN.
-])
-
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0],
-[OK
-])
-
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION LOCALE-TIME])
-AT_KEYWORDS([functions])
-
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 X PIC X(32) VALUE SPACES.
- PROCEDURE DIVISION.
- MOVE FUNCTION LOCALE-TIME ( "233012" ) TO X.
- IF X NOT = SPACES
- DISPLAY "OK"
- END-DISPLAY
- END-IF.
- STOP RUN.
-])
-
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0],
-[OK
-])
-
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION LOCALE-TIME-FROM-SECONDS])
-AT_KEYWORDS([functions])
-
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 X PIC X(32) VALUE SPACES.
- PROCEDURE DIVISION.
- MOVE FUNCTION LOCALE-TIME-FROM-SECONDS ( 33012 ) TO X.
- IF X NOT = SPACES
- DISPLAY "OK"
- END-DISPLAY
- END-IF.
- STOP RUN.
-])
-
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0],
-[OK
-])
-
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION LOG])
-AT_KEYWORDS([functions])
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 Y PIC S9V9(33).
- PROCEDURE DIVISION.
- MOVE FUNCTION LOG ( 1.5 ) TO Y.
- IF Y NOT = 0.405465108108164381978013115464349
- DISPLAY Y
- END-DISPLAY
- END-IF.
- STOP RUN.
-])
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION LOG10])
-AT_KEYWORDS([functions])
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 Y PIC S9V9(33).
- PROCEDURE DIVISION.
- MOVE FUNCTION LOG10 ( 1.5 ) TO Y.
- IF Y NOT = 0.176091259055681242081289008530622
- DISPLAY Y
- END-DISPLAY
- END-IF.
- STOP RUN.
-])
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION LOWER-CASE])
-AT_KEYWORDS([functions])
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 X PIC X(10) VALUE "A#B.C%D+E$".
- 01 TEST-FLD PIC X(12) VALUE ALL '_'.
- PROCEDURE DIVISION.
- STRING FUNCTION LOWER-CASE ( X )
- DELIMITED BY SIZE
- INTO TEST-FLD
- END-STRING
- IF TEST-FLD NOT = 'a#b.c%d+e$__'
- DISPLAY TEST-FLD
- END-DISPLAY
- END-IF.
- STOP RUN.
-])
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
-
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION LOWER-CASE with reference modding])
-AT_KEYWORDS([functions])
-
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 X PIC X(10) VALUE "A#B.C%D+E$".
- 01 TEST-FLD PIC X(03).
- PROCEDURE DIVISION.
- MOVE FUNCTION LOWER-CASE ( X ) (1 : 3)
- TO TEST-FLD
- IF TEST-FLD NOT = 'a#b'
- DISPLAY TEST-FLD
- END-DISPLAY
- END-IF.
- STOP RUN.
-])
-
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
-
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION LOWEST-ALGEBRAIC])
-AT_KEYWORDS([functions])
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 F1 PIC S999.
- 01 F2 PIC S9(4) BINARY.
- 01 F3 PIC 99V9(3).
- 01 F4 PIC $**,**9.99BCR.
- 01 F5 PIC $**,**9.99.
- 01 F6 USAGE BINARY-CHAR SIGNED.
- 01 F7 USAGE BINARY-CHAR UNSIGNED.
- 01 F8 PIC S999PPP.
- 01 F9 PIC SP99.
- PROCEDURE DIVISION.
- IF FUNCTION LOWEST-ALGEBRAIC (F1) NOT = -999
- DISPLAY "Test 1 fail"
- END-DISPLAY
- END-IF.
- IF FUNCTION LOWEST-ALGEBRAIC (F2) NOT = -9999
- DISPLAY "Test 2 fail"
- END-DISPLAY
- END-IF.
- IF FUNCTION LOWEST-ALGEBRAIC (F3) NOT = 0
- DISPLAY "Test 3 fail"
- END-DISPLAY
- END-IF.
- IF FUNCTION LOWEST-ALGEBRAIC (F4) NOT = -99999.99
- DISPLAY "Test 4 fail"
- END-DISPLAY
- END-IF.
- IF FUNCTION LOWEST-ALGEBRAIC (F5) NOT = 0
- DISPLAY "Test 5 fail"
- END-DISPLAY
- END-IF.
- IF FUNCTION LOWEST-ALGEBRAIC (F6) NOT = -128
- DISPLAY "Test 6 fail"
- END-DISPLAY
- END-IF.
- IF FUNCTION LOWEST-ALGEBRAIC (F7) NOT = 0
- DISPLAY "Test 7 fail"
- END-DISPLAY
- END-IF.
- IF FUNCTION LOWEST-ALGEBRAIC (F8) NOT = -999000
- DISPLAY "Test 8 fail"
- END-DISPLAY
- END-IF.
- IF FUNCTION LOWEST-ALGEBRAIC (F9) NOT = -0.099
- DISPLAY "Test 9 fail"
- END-DISPLAY
- END-IF.
-
- STOP RUN.
-])
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION MAX])
-AT_KEYWORDS([functions])
-
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- PROCEDURE DIVISION.
- DISPLAY FUNCTION MAX ( 3 -14 0 8 -3 )
- END-DISPLAY.
- STOP RUN.
-])
-
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0],
-[8
-], [])
-
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION MEAN])
-AT_KEYWORDS([functions])
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 result PIC S999V999.
- PROCEDURE DIVISION.
- COMPUTE result = FUNCTION MEAN ( 3 -14 0 8 -3 )
- DISPLAY result
- END-DISPLAY.
- STOP RUN.
-])
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0],
-[-001.200
-])
-
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION MEDIAN])
-AT_KEYWORDS([functions])
-
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- PROCEDURE DIVISION.
- DISPLAY FUNCTION MEDIAN ( 3 -14 0 8 -3 )
- END-DISPLAY.
- STOP RUN.
-])
-
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0],
-[0
-])
-
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION MIDRANGE])
-AT_KEYWORDS([functions])
-
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 RESULT PIC S999V999.
- PROCEDURE DIVISION.
- COMPUTE RESULT = FUNCTION MIDRANGE ( 3 -14 0 8 -3 )
- DISPLAY RESULT
- END-DISPLAY.
- STOP RUN.
-])
-
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0],
-[-003.000
-])
-
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION MIN])
-AT_KEYWORDS([functions])
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- PROCEDURE DIVISION.
- DISPLAY FUNCTION MIN ( 3 -14 0 8 -3 )
- END-DISPLAY.
- STOP RUN.
-])
-
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0],
-[-14
-])
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION MOD (valid)])
-AT_KEYWORDS([functions])
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 Y PIC 9(12) VALUE 600851475143.
- 01 R PIC S9(4)V9(4) VALUE 0.
- PROCEDURE DIVISION.
- MOVE FUNCTION MOD ( -11 5 ) TO R
- IF R NOT = 4
- DISPLAY 'first one wrong: ' R
- END-DISPLAY
- END-IF
- MOVE FUNCTION MOD ( Y, 71 ) TO R
- IF R NOT = 0
- DISPLAY 'second one wrong: ' R
- END-DISPLAY
- END-IF
- STOP RUN.
-])
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION MOD (invalid)])
-AT_KEYWORDS([functions exceptions])
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 Z PIC 9 VALUE 0.
- 01 R PIC S9(4)V9(4) VALUE 1.
- PROCEDURE DIVISION.
- MOVE FUNCTION MOD ( -11 Z ) TO R
- IF FUNCTION EXCEPTION-STATUS
- NOT = 'EC-ARGUMENT-FUNCTION'
- DISPLAY 'Wrong/missing exception: '
- FUNCTION EXCEPTION-STATUS
- END-DISPLAY
- END-IF
- IF R NOT = 0
- DISPLAY 'result is not zero: ' R
- END-DISPLAY
- END-IF
- STOP RUN.
-])
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION MODULE-CALLER-ID])
-AT_KEYWORDS([functions])
-AT_XFAIL_IF([test "$COB_DIALECT" != "gnu"])
-
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- ENVIRONMENT DIVISION.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- PROCEDURE DIVISION.
- CALL "prog2"
- END-CALL.
- STOP RUN.
-])
-
-AT_DATA([prog2.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog2.
- ENVIRONMENT DIVISION.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- PROCEDURE DIVISION.
- DISPLAY FUNCTION MODULE-CALLER-ID NO ADVANCING
- END-DISPLAY.
- EXIT PROGRAM.
-])
-
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COMPILE_MODULE prog2.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [prog])
-
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION MODULE-DATE])
-AT_KEYWORDS([functions])
-AT_XFAIL_IF([test "$COB_DIALECT" != "gnu"])
-
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- ENVIRONMENT DIVISION.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 TEST-DATE PIC 9(8) VALUE 0.
- PROCEDURE DIVISION.
- MOVE FUNCTION MODULE-DATE TO TEST-DATE.
- IF TEST-DATE NOT = 0
- DISPLAY "OK" NO ADVANCING
- END-DISPLAY
- END-IF.
- STOP RUN.
-])
-
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [OK], [])
-
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION MODULE-FORMATTED-DATE])
-AT_KEYWORDS([functions])
-AT_XFAIL_IF([test "$COB_DIALECT" != "gnu"])
-
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- ENVIRONMENT DIVISION.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 TEST-DATE PIC X(16) VALUE SPACES.
- PROCEDURE DIVISION.
- MOVE FUNCTION MODULE-FORMATTED-DATE TO TEST-DATE.
- IF TEST-DATE NOT = SPACES
- DISPLAY "OK" NO ADVANCING
- END-DISPLAY
- END-IF.
- STOP RUN.
-])
-
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [OK], [])
-
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION MODULE-ID])
-AT_KEYWORDS([functions])
-AT_XFAIL_IF([test "$COB_DIALECT" != "gnu"])
-
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- ENVIRONMENT DIVISION.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- PROCEDURE DIVISION.
- DISPLAY FUNCTION MODULE-ID NO ADVANCING
- END-DISPLAY.
- STOP RUN.
-])
-
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [prog])
-
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION MODULE-PATH])
-AT_KEYWORDS([functions])
-AT_XFAIL_IF([test "$COB_DIALECT" != "gnu"])
-
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- ENVIRONMENT DIVISION.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 TEST-PATH PIC X(16) VALUE SPACES.
- PROCEDURE DIVISION.
- MOVE FUNCTION MODULE-PATH TO TEST-PATH.
- IF TEST-PATH NOT = SPACES
- DISPLAY "OK" NO ADVANCING
- END-DISPLAY
- END-IF.
- STOP RUN.
-])
-
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [OK], [])
-
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION MODULE-SOURCE])
-AT_KEYWORDS([functions])
-AT_XFAIL_IF([test "$COB_DIALECT" != "gnu"])
-
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- ENVIRONMENT DIVISION.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- PROCEDURE DIVISION.
- DISPLAY FUNCTION MODULE-SOURCE NO ADVANCING
- END-DISPLAY.
- STOP RUN.
-])
-
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [prog.cob])
-
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION MODULE-TIME])
-AT_KEYWORDS([functions])
-AT_XFAIL_IF([test "$COB_DIALECT" != "gnu"])
-
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- ENVIRONMENT DIVISION.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 TEST-TIME PIC 9(6) VALUE 0.
- PROCEDURE DIVISION.
- MOVE FUNCTION MODULE-TIME TO TEST-TIME.
- IF TEST-TIME NOT = 0
- DISPLAY "OK" NO ADVANCING
- END-DISPLAY
- END-IF.
- STOP RUN.
-])
-
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [OK], [])
-
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION MONETARY-DECIMAL-POINT])
-AT_KEYWORDS([functions])
-AT_XFAIL_IF([test "$COB_DIALECT" != "gnu"])
-
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- ENVIRONMENT DIVISION.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 TEST-FLD PIC X(8) VALUE SPACES.
- PROCEDURE DIVISION.
- MOVE FUNCTION MONETARY-DECIMAL-POINT TO TEST-FLD.
- DISPLAY "OK" NO ADVANCING
- END-DISPLAY
- STOP RUN.
-])
-
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [OK], [])
-
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION MONETARY-THOUSANDS-SEPARATOR])
-AT_KEYWORDS([functions])
-AT_XFAIL_IF([test "$COB_DIALECT" != "gnu"])
-
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- ENVIRONMENT DIVISION.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 TEST-FLD PIC X(8) VALUE SPACES.
- PROCEDURE DIVISION.
- MOVE FUNCTION MONETARY-THOUSANDS-SEPARATOR TO TEST-FLD.
- DISPLAY "OK" NO ADVANCING
- END-DISPLAY
- STOP RUN.
-])
-
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [OK], [])
-
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION NUMERIC-DECIMAL-POINT])
-AT_KEYWORDS([functions])
-AT_XFAIL_IF([test "$COB_DIALECT" != "gnu"])
-
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- ENVIRONMENT DIVISION.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 TEST-FLD PIC X(8) VALUE SPACES.
- PROCEDURE DIVISION.
- MOVE FUNCTION NUMERIC-DECIMAL-POINT TO TEST-FLD.
- DISPLAY "OK" NO ADVANCING
- END-DISPLAY
- STOP RUN.
-])
-
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [OK], [])
-
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION NUMERIC-THOUSANDS-SEPARATOR])
-AT_KEYWORDS([functions])
-AT_XFAIL_IF([test "$COB_DIALECT" != "gnu"])
-
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- ENVIRONMENT DIVISION.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 TEST-FLD PIC X(8) VALUE SPACES.
- PROCEDURE DIVISION.
- MOVE FUNCTION NUMERIC-THOUSANDS-SEPARATOR TO TEST-FLD.
- DISPLAY "OK" NO ADVANCING
- END-DISPLAY
- STOP RUN.
-])
-
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [OK], [])
-
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION NUMVAL])
-AT_KEYWORDS([functions])
-
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 X1 PIC X(12) VALUE " -9876.1234 ".
- 01 X2 PIC X(18) VALUE " 19876.1234 CR".
- 01 N PIC s9(5)v9(5).
- PROCEDURE DIVISION.
- MOVE FUNCTION NUMVAL ( X1 ) TO N
- IF N NOT = -9876.1234
- DISPLAY N
- END-DISPLAY
- END-IF
- MOVE FUNCTION NUMVAL ( X2 ) TO N
- IF N NOT = -19876.1234
- DISPLAY N
- END-DISPLAY
- END-IF
- STOP RUN.
-])
-
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
-
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION NUMVAL-C])
-AT_KEYWORDS([functions])
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 X1 PIC X(14) VALUE " -% 9876.1234 ".
- 01 X2 PIC X(20) VALUE " % 19,876.1234 DB".
- 01 N PIC s9(5)v9(5).
- PROCEDURE DIVISION.
- MOVE FUNCTION NUMVAL-C ( X1 , "%" ) TO N
- IF N NOT = -9876.1234
- DISPLAY N
- END-DISPLAY
- END-IF
- MOVE FUNCTION NUMVAL-C ( X2 , "%" ) TO N
- IF N NOT = -19876.1234
- DISPLAY N
- END-DISPLAY
- END-IF
- STOP RUN.
-])
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION NUMVAL-C DP.COMMA])
-AT_KEYWORDS([functions])
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- ENVIRONMENT DIVISION.
- CONFIGURATION SECTION.
- SPECIAL-NAMES.
- DECIMAL-POINT IS COMMA
- .
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 X1 PIC X(20) VALUE " % 19.876,1234 DB".
- 01 N PIC s9(5)v9(5).
- PROCEDURE DIVISION.
- MOVE FUNCTION NUMVAL-C ( X1 , "%" ) TO N
- IF N NOT = -19876,1234
- DISPLAY N
- END-DISPLAY
- END-IF
- STOP RUN.
-])
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION NUMVAL-F])
-AT_KEYWORDS([functions])
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 result PIC S9(8)V9(9) COMP-5.
- 01 vector.
- 05 vd.
- 10 FILLER PIC X(32) VALUE " - 123.456 E + 2 ".
- 10 FILLER PIC X(32) VALUE "123".
- 10 FILLER PIC X(32) VALUE ".456".
- 10 FILLER PIC X(32) VALUE "123.456".
- 10 FILLER PIC X(32) VALUE "-123.456".
- 10 FILLER PIC X(32) VALUE "123.456E2".
- 10 FILLER PIC X(32) VALUE "-123.456E-2".
- 10 FILLER PIC X(32) VALUE "DONE".
- 10 FILLER PIC X(32) OCCURS 100 TIMES.
- 05 datat REDEFINES vd PIC X(32) OCCURS 100 TIMES INDEXED BY I.
- PROCEDURE DIVISION.
- SET I TO 1
- PERFORM UNTIL datat(I) EQUALS "DONE"
- DISPLAY """"datat(I)"""" SPACE WITH NO ADVANCING
- MOVE FUNCTION NUMVAL-F(datat(I)) TO result
- DISPLAY result
- ADD 1 TO I
- END-PERFORM.
- STOP RUN.
-])
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0],
-[" - 123.456 E + 2 " -00012345.600000000
-"123 " +00000123.000000000
-".456 " +00000000.456000000
-"123.456 " +00000123.456000000
-"-123.456 " -00000123.456000000
-"123.456E2 " +00012345.600000000
-"-123.456E-2 " -00000001.234560000
-])
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION ORD])
-AT_KEYWORDS([functions])
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 RESULT PIC 999.
- PROCEDURE DIVISION.
- MOVE FUNCTION ORD ( "k" ) TO RESULT
- DISPLAY RESULT
- END-DISPLAY.
- STOP RUN.
-])
-
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0],
-[108
-])
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION ORD-MAX])
-AT_KEYWORDS([functions])
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 RESULT PIC 999.
- PROCEDURE DIVISION.
- MOVE FUNCTION ORD-MAX ( 3 -14 0 8 -3 ) TO RESULT
- DISPLAY RESULT
- END-DISPLAY.
- STOP RUN.
-])
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0],
-[004
-])
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION ORD-MIN])
-AT_KEYWORDS([functions])
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 RESULT PIC 999.
- PROCEDURE DIVISION.
- MOVE FUNCTION ORD-MIN ( 3 -14 0 8 -3 ) TO RESULT
- DISPLAY RESULT
- END-DISPLAY.
- STOP RUN.
-])
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0],
-[002
-])
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION PI])
-AT_KEYWORDS([functions])
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 Y PIC 9V9(32).
- PROCEDURE DIVISION.
- MOVE FUNCTION PI TO Y.
- IF Y NOT = 3.14159265358979323846264338327950
- DISPLAY Y
- END-DISPLAY
- END-IF.
- STOP RUN.
-])
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION PRESENT-VALUE])
-AT_KEYWORDS([functions])
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 RESULT PIC 9(5)V9(4).
- PROCEDURE DIVISION.
- MOVE FUNCTION PRESENT-VALUE ( 3 2 1 ) TO RESULT
- DISPLAY RESULT
- END-DISPLAY.
- STOP RUN.
-])
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0],
-[00000.5625
-])
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION RANDOM])
-AT_KEYWORDS([functions])
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 Y PIC S99V99 COMP VALUE -1.0.
- PROCEDURE DIVISION.
- MOVE FUNCTION RANDOM ( ) TO Y.
- IF Y < 0
- DISPLAY Y
- END-DISPLAY
- END-IF.
- STOP RUN.
-])
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION RANGE])
-AT_KEYWORDS([functions])
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 Z PIC S9(4)V9(4) COMP-5.
- PROCEDURE DIVISION.
- MOVE FUNCTION RANGE ( 3 -14 0 8 -3 ) TO Z.
- IF Z NOT = 22
- DISPLAY Z
- END-DISPLAY
- END-IF.
- STOP RUN.
-])
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION REM (valid)])
-AT_KEYWORDS([functions])
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 R PIC S9(4)V9(4) COMP-5 VALUE 0.
- PROCEDURE DIVISION.
- MOVE FUNCTION REM ( -11 5 ) TO R
- IF R NOT = -1
- DISPLAY R END-DISPLAY
- END-IF
- STOP RUN.
-])
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION REM (invalid)])
-AT_KEYWORDS([functions exceptions])
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 R PIC S9(4)V9(4) COMP-5 VALUE 4.1.
- 01 Z PIC 9 COMP-5 VALUE 0.
- PROCEDURE DIVISION.
- MOVE FUNCTION REM ( -11 Z ) TO R
- IF FUNCTION EXCEPTION-STATUS
- NOT = 'EC-ARGUMENT-FUNCTION'
- DISPLAY 'Wrong/missing exception: '
- FUNCTION EXCEPTION-STATUS
- END-DISPLAY
- END-IF
- IF R NOT = 0
- DISPLAY 'result is not zero: ' R
- END-DISPLAY
- END-IF
- STOP RUN.
-])
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION REVERSE])
-AT_KEYWORDS([functions])
-
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 X PIC X(10) VALUE "A#B.C%D+E$".
- 01 Z PIC X(10).
- PROCEDURE DIVISION.
- MOVE FUNCTION REVERSE ( X ) TO Z.
- IF Z NOT = "$E+D%C.B#A"
- DISPLAY Z
- END-DISPLAY
- END-IF.
- STOP RUN.
-])
-
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
-
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION REVERSE with reference modding])
-AT_KEYWORDS([functions])
-
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 X PIC X(10) VALUE "A#B.C%D+E$".
- 01 Z PIC X(10).
- PROCEDURE DIVISION.
- MOVE FUNCTION REVERSE ( X ) (1 : 4) TO Z.
- IF Z NOT = "$E+D "
- DISPLAY Z
- END-DISPLAY
- END-IF.
- STOP RUN.
-])
-
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
-
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION SECONDS-FROM-FORMATTED-TIME])
-AT_KEYWORDS([functions])
-
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 result PIC 9(8)V9(9) COMP-5.
- PROCEDURE DIVISION.
- MOVE FUNCTION SECONDS-FROM-FORMATTED-TIME
- ("hhmmss", "010203")
- TO result.
- IF result NOT = 3723
- DISPLAY "Test 1 failed: " result
- END-DISPLAY
- END-IF.
-
- MOVE FUNCTION SECONDS-FROM-FORMATTED-TIME
- ("hh:mm:ss", "01:02:03")
- TO result.
- IF result NOT = 3723
- DISPLAY "Test 2 failed: " result
- END-DISPLAY
- END-IF.
-
- MOVE FUNCTION SECONDS-FROM-FORMATTED-TIME
- ("hhmmss.ssssssss", "010203.04050607")
- TO result.
- IF result NOT = 3723.04050607
- DISPLAY "Test 3 failed: " result
- END-DISPLAY
- END-IF.
-
- MOVE FUNCTION SECONDS-FROM-FORMATTED-TIME
- ("hhmmssZ", "010203Z")
- TO result.
- IF result NOT = 3723
- DISPLAY "Test 4 failed: " result
- END-DISPLAY
- END-IF.
-
- MOVE FUNCTION SECONDS-FROM-FORMATTED-TIME
- ("hhmmss+hhmm", "010203+0405")
- TO result.
- IF result NOT = 3723
- DISPLAY "Test 5 failed: " result
- END-DISPLAY
- END-IF.
-
- MOVE FUNCTION SECONDS-FROM-FORMATTED-TIME
- ("YYYYMMDDThhmmss", "16010101T010203")
- TO result.
- IF result NOT = 3723
- DISPLAY "Test 6 failed: " result
- END-DISPLAY
- END-IF.
-
- STOP RUN.
-])
-
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
-
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION SECONDS-PAST-MIDNIGHT])
-AT_KEYWORDS([functions])
-
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 Y PIC 9(8) COMP-5.
- PROCEDURE DIVISION.
- MOVE FUNCTION SECONDS-PAST-MIDNIGHT TO Y.
- IF Y NOT < 86402
- DISPLAY Y
- END-DISPLAY
- END-IF.
- STOP RUN.
-])
-
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
-
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION SIGN])
-AT_KEYWORDS([functions])
-
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 Z USAGE BINARY-LONG SIGNED.
- PROCEDURE DIVISION.
- MOVE FUNCTION SIGN ( 3.12345 ) TO Z.
- IF Z NOT = 1
- DISPLAY "Sign 1 " Z
- END-DISPLAY
- END-IF.
- MOVE FUNCTION SIGN ( -0.0 ) TO Z.
- IF Z NOT = 0
- DISPLAY "Sign 2 " Z
- END-DISPLAY
- END-IF.
- MOVE FUNCTION SIGN ( 0.0 ) TO Z.
- IF Z NOT = 0
- DISPLAY "Sign 3 " Z
- END-DISPLAY
- END-IF.
- MOVE FUNCTION SIGN ( -3.12345 ) TO Z.
- IF Z NOT = -1
- DISPLAY "Sign 4 " Z
- END-DISPLAY
- END-IF.
- STOP RUN.
-])
-
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
-
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION SIN])
-AT_KEYWORDS([functions])
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 Y PIC S9V9(33).
- PROCEDURE DIVISION.
- MOVE FUNCTION SIN ( 1.5 ) TO Y.
- IF Y NOT = 0.997494986604054430941723371141487
- DISPLAY Y
- END-DISPLAY
- END-IF.
- STOP RUN.
-])
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION SQRT])
-AT_KEYWORDS([functions])
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 Y PIC S9V9(33).
- PROCEDURE DIVISION.
- MOVE FUNCTION SQRT ( 1.5 ) TO Y.
- IF Y NOT = 1.224744871391589049098642037352945
- DISPLAY Y
- END-DISPLAY
- END-IF.
- STOP RUN.
-])
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION STANDARD-DEVIATION])
-AT_KEYWORDS([functions])
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 Y PIC S9V9(32).
- PROCEDURE DIVISION.
- MOVE FUNCTION STANDARD-DEVIATION ( 3 -14 0 8 -3 ) TO Y.
- IF Y NOT = 7.35934779718963954877237043574538
- DISPLAY Y
- END-DISPLAY
- END-IF.
- STOP RUN.
-])
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION STORED-CHAR-LENGTH])
-AT_KEYWORDS([functions])
-AT_XFAIL_IF([test "$COB_DIALECT" != "gnu"])
-
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 Y PIC X(24).
- 01 Z USAGE BINARY-LONG.
- PROCEDURE DIVISION.
- MOVE "123456789012" TO Y.
- MOVE FUNCTION STORED-CHAR-LENGTH ( Y ) TO Z.
- IF Z NOT = 12
- DISPLAY Z
- END-DISPLAY
- END-IF.
- STOP RUN.
-])
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION SUBSTITUTE])
-AT_KEYWORDS([functions])
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 Y PIC X(24).
- PROCEDURE DIVISION.
- MOVE "abc111444555defxxabc" TO Y
- DISPLAY FUNCTION TRIM (FUNCTION SUBSTITUTE ( Y "abc" "zz" "55" "666" ))
-
- MOVE "bobBobjimJimbobBobjimJim" TO Y
- DISPLAY FUNCTION SUBSTITUTE ( Y "bob" "FILLER" "jim" "Z")
-
- MOVE "bobBobjimJimbobBobjimJim" TO Y
- DISPLAY FUNCTION SUBSTITUTE ( Y FIRST "bob" "FILLER" "jim" "Z")
-
- MOVE "bobBobjimJimbobBobjimJim" TO Y
- DISPLAY FUNCTION SUBSTITUTE ( Y LAST "bob" "FILLER" "jim" "Z")
-
- MOVE "bobBobjimJimbobBobjimJim" TO Y
- DISPLAY FUNCTION SUBSTITUTE ( Y ANYCASE "bob" "FILLER" ANYCASE "jim" "Z")
-])
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0],
-[zz1114446665defxxzz
-FILLERBobZJimFILLERBobZJim
-FILLERBobZJimbobBobZJim
-bobBobZJimFILLERBobZJim
-FILLERFILLERZZFILLERFILLERZZ
-], [])
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION SUBSTITUTE with reference modding])
-AT_KEYWORDS([functions])
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 Y PIC X(20).
- 01 Z PIC X(20).
- PROCEDURE DIVISION.
- MOVE "abc111444555defxxabc" TO Y.
- MOVE FUNCTION SUBSTITUTE
- ( Y "abc" "zz" "55" "666" ) (2 : 9)
- TO Z.
- IF Z NOT = "z11144466"
- DISPLAY Z
- END-DISPLAY
- END-IF.
- STOP RUN.
-])
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION SUBSTITUTE-CASE])
-AT_KEYWORDS([functions])
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 Y PIC X(20).
- 01 Z PIC X(20).
- PROCEDURE DIVISION.
- MOVE "ABC111444555defxxabc" TO Y.
- MOVE FUNCTION SUBSTITUTE (Y anycase "abc" "zz"
- anycase "55" "666")
- TO Z.
- IF Z NOT = "zz1114446665defxxzz"
- DISPLAY Z
- END-DISPLAY
- END-IF.
- STOP RUN.
-])
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION SUBSTITUTE-CASE with reference mod])
-AT_KEYWORDS([functions])
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 Y PIC X(20).
- 01 Z PIC X(20).
- PROCEDURE DIVISION.
- MOVE "abc111444555defxxabc" TO Y.
- MOVE FUNCTION SUBSTITUTE
- ( Y anycase "ABC" "zz"
- anycase "55" "666" ) (2 : 9)
- TO Z.
- IF Z NOT = "z11144466"
- DISPLAY Z
- END-DISPLAY
- END-IF.
- STOP RUN.
-])
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION SUM])
-AT_KEYWORDS([functions])
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 Z USAGE BINARY-LONG.
- PROCEDURE DIVISION.
- MOVE FUNCTION SUM ( 3 -14 0 8 -3 ) TO Z.
- IF Z NOT = -6
- DISPLAY Z
- END-DISPLAY
- END-IF.
- STOP RUN.
-])
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION TAN])
-AT_KEYWORDS([functions])
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 Y PIC S99V9(31).
- PROCEDURE DIVISION.
- MOVE FUNCTION TAN ( 1.5 ) TO Y.
- IF Y NOT = 14.1014199471717193876460836519877
- DISPLAY Y
- END-DISPLAY
- END-IF.
- STOP RUN.
-])
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION TEST-DATE-YYYYMMDD])
-AT_KEYWORDS([functions])
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 RESULT PIC 999.
- PROCEDURE DIVISION.
- MOVE FUNCTION TEST-DATE-YYYYMMDD ( 20020231 ) TO RESULT
- DISPLAY RESULT
- END-DISPLAY.
- STOP RUN.
-])
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0],
-[003
-])
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION TEST-DAY-YYYYDDD])
-AT_KEYWORDS([functions])
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 RESULT PIC 999.
- PROCEDURE DIVISION.
- MOVE FUNCTION TEST-DAY-YYYYDDD ( 2002400 ) TO RESULT
- DISPLAY RESULT
- END-DISPLAY.
- STOP RUN.
-])
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0],
-[002
-])
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION TEST-FORMATTED-DATETIME with dates])
-AT_KEYWORDS([functions])
-
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- PROCEDURE DIVISION.
- IF FUNCTION TEST-FORMATTED-DATETIME
- ("YYYYMMDD", "16010101") <> 0
- DISPLAY "Test 1 failed" END-DISPLAY
- END-IF
- IF FUNCTION TEST-FORMATTED-DATETIME
- ("YYYY-MM-DD", "1601-01-01") <> 0
- DISPLAY "Test 2 failed" END-DISPLAY
- END-IF
- IF FUNCTION TEST-FORMATTED-DATETIME
- ("YYYYDDD", "1601001") <> 0
- DISPLAY "Test 3 failed" END-DISPLAY
- END-IF
- IF FUNCTION TEST-FORMATTED-DATETIME
- ("YYYY-DDD", "1601-001") <> 0
- DISPLAY "Test 4 failed" END-DISPLAY
- END-IF
- IF FUNCTION TEST-FORMATTED-DATETIME
- ("YYYYWwwD", "1601W011") <> 0
- DISPLAY "Test 5 failed" END-DISPLAY
- END-IF
- IF FUNCTION TEST-FORMATTED-DATETIME
- ("YYYY-Www-D", "1601-W01-1") <> 0
- DISPLAY "Test 6 failed" END-DISPLAY
- END-IF
-
-
- *> How will this work with zero-length items?
- IF FUNCTION TEST-FORMATTED-DATETIME
- ("YYYYMMDD", "1") <> 2
- DISPLAY "Test 7 failed" END-DISPLAY
- END-IF
- IF FUNCTION TEST-FORMATTED-DATETIME
- ("YYYYMMDD", "160A0101") <> 4
- DISPLAY "Test 8 failed" END-DISPLAY
- END-IF
- IF FUNCTION TEST-FORMATTED-DATETIME
- ("YYYYMMDD", "00000101") <> 1
- DISPLAY "Test 9 failed" END-DISPLAY
- END-IF
- IF FUNCTION TEST-FORMATTED-DATETIME
- ("YYYYMMDD", "16000101") <> 4
- DISPLAY "Test 10 failed" END-DISPLAY
- END-IF
- IF FUNCTION TEST-FORMATTED-DATETIME
- ("YYYYMMDD", "16010001") <> 6
- DISPLAY "Test 11 failed" END-DISPLAY
- END-IF
- IF FUNCTION TEST-FORMATTED-DATETIME
- ("YYYYMMDD", "16011301") <> 6
- DISPLAY "Test 12 failed" END-DISPLAY
- END-IF
- IF FUNCTION TEST-FORMATTED-DATETIME
- ("YYYYMMDD", "16010190") <> 7
- DISPLAY "Test 13 failed" END-DISPLAY
- END-IF
- IF FUNCTION TEST-FORMATTED-DATETIME
- ("YYYYMMDD", "18000229") <> 8
- DISPLAY "Test 14 failed" END-DISPLAY
- END-IF
- IF FUNCTION TEST-FORMATTED-DATETIME
- ("YYYY-MM-DD", "1601 01 01") <> 5
- DISPLAY "Test 15 failed" END-DISPLAY
- END-IF
- IF FUNCTION TEST-FORMATTED-DATETIME
- ("YYYYMMDD", "160101010") <> 9
- DISPLAY "Test 16 failed" END-DISPLAY
- END-IF
- IF FUNCTION TEST-FORMATTED-DATETIME
- ("YYYYWwwD", "1601A011") <> 5
- DISPLAY "Test 17 failed" END-DISPLAY
- END-IF
- IF FUNCTION TEST-FORMATTED-DATETIME
- ("YYYYWwwD", "1601W531") <> 7
- DISPLAY "Test 18 failed" END-DISPLAY
- END-IF
- IF FUNCTION TEST-FORMATTED-DATETIME
- ("YYYYWwwD", "1601W601") <> 6
- DISPLAY "Test 19 failed" END-DISPLAY
- END-IF
- IF FUNCTION TEST-FORMATTED-DATETIME
- ("YYYYWwwD", "2009W531") <> 0
- DISPLAY "Test 20 failed" END-DISPLAY
- END-IF
- IF FUNCTION TEST-FORMATTED-DATETIME
- ("YYYYWwwD", "1601W018") <> 8
- DISPLAY "Test 21 failed" END-DISPLAY
- END-IF
- IF FUNCTION TEST-FORMATTED-DATETIME
- ("YYYYDDD", "1601366") <> 7
- DISPLAY "Test 22 failed" END-DISPLAY
- END-IF
- IF FUNCTION TEST-FORMATTED-DATETIME
- ("YYYYDDD", "1601370") <> 6
- DISPLAY "Test 23 failed" END-DISPLAY
- END-IF
- IF FUNCTION TEST-FORMATTED-DATETIME
- ("YYYYDDD", "1601400") <> 5
- DISPLAY "Test 24 failed" END-DISPLAY
- END-IF
- IF FUNCTION TEST-FORMATTED-DATETIME
- ("YYYYMMDD", "01") <> 1
- DISPLAY "Test 25 failed" END-DISPLAY
- END-IF
- IF FUNCTION TEST-FORMATTED-DATETIME
- ("YYYYMMDD", "1601010") <> 8
- DISPLAY "Test 26 failed" END-DISPLAY
- END-IF
-
- STOP RUN
- .
-])
-
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
-
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION TEST-FORMATTED-DATETIME with times])
-AT_KEYWORDS([functions])
-
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- PROCEDURE DIVISION.
- IF FUNCTION TEST-FORMATTED-DATETIME
- ("hhmmss.sssssssssZ", "000000.000000000Z") <> 0
- DISPLAY "Test 1 failed" END-DISPLAY
- END-IF
- IF FUNCTION TEST-FORMATTED-DATETIME
- ("hh:mm:ss.sssssssssZ", "00:00:00.000000000Z") <> 0
- DISPLAY "Test 2 failed" END-DISPLAY
- END-IF
- *> 0 instead of +/- valid in sending fields with offset of zero.
- IF FUNCTION TEST-FORMATTED-DATETIME
- ("hhmmss.sssssssss+hhmm", "000000.00000000000000")
- <> 0
- DISPLAY "Test 3 failed" END-DISPLAY
- END-IF
- IF FUNCTION TEST-FORMATTED-DATETIME
- ("hh:mm:ss.sssssssss+hh:mm",
- "00:00:00.000000000+00:00")
- <> 0
- DISPLAY "Test 4 failed" END-DISPLAY
- END-IF
-
- IF FUNCTION TEST-FORMATTED-DATETIME
- ("hhmmss", "300000") <> 1
- DISPLAY "Test 5 failed" END-DISPLAY
- END-IF
- IF FUNCTION TEST-FORMATTED-DATETIME
- ("hhmmss", "250000") <> 2
- DISPLAY "Test 6 failed" END-DISPLAY
- END-IF
- IF FUNCTION TEST-FORMATTED-DATETIME
- ("hhmmss", "006000") <> 3
- DISPLAY "Test 7 failed" END-DISPLAY
- END-IF
- IF FUNCTION TEST-FORMATTED-DATETIME
- ("hhmmss", "000060") <> 5
- DISPLAY "Test 8 failed" END-DISPLAY
- END-IF
- IF FUNCTION TEST-FORMATTED-DATETIME
- ("hh:mm:ss", "00-00-00") <> 3
- DISPLAY "Test 9 failed" END-DISPLAY
- END-IF
- IF FUNCTION TEST-FORMATTED-DATETIME
- ("hhmmss.ss", "000000,00") <> 7
- DISPLAY "Test 10 failed" END-DISPLAY
- END-IF
- IF FUNCTION TEST-FORMATTED-DATETIME
- ("hhmmss+hhmm", "000000 0000") <> 7
- DISPLAY "Test 11 failed" END-DISPLAY
- END-IF
- IF FUNCTION TEST-FORMATTED-DATETIME
- ("hhmmss+hhmm", "00000000001") <> 11
- DISPLAY "Test 12 failed" END-DISPLAY
- END-IF
- IF FUNCTION TEST-FORMATTED-DATETIME
- ("hhmmssZ", "000000A") <> 7
- DISPLAY "Test 13 failed" END-DISPLAY
- END-IF
- IF FUNCTION TEST-FORMATTED-DATETIME
- ("hhmmss", SPACE) <> 1
- DISPLAY "Test 14 failed" END-DISPLAY
- END-IF
-
- STOP RUN
- .
-])
-
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
-
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION TEST-FORMATTED-DATETIME with datetimes])
-AT_KEYWORDS([functions])
-
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 77 RESULT PIC 9(02).
- PROCEDURE DIVISION.
- MOVE FUNCTION TEST-FORMATTED-DATETIME
- ("YYYYMMDDThhmmss", "16010101T000000")
- TO RESULT
- IF RESULT <> 0
- DISPLAY "Test 1 failed: " RESULT END-DISPLAY
- END-IF
- MOVE FUNCTION TEST-FORMATTED-DATETIME
- ("YYYY-MM-DDThh:mm:ss.sssssssss+hh:mm",
- "1601-01-01T00:00:00.000000000+00:00")
- TO RESULT
- IF RESULT <> 0
- DISPLAY "Test 2 failed: " RESULT END-DISPLAY
- END-IF
-
- MOVE FUNCTION TEST-FORMATTED-DATETIME
- ("YYYYMMDDThhmmss", "16010101 000000")
- TO RESULT
- IF RESULT <> 9
- DISPLAY "Test 3 failed: " RESULT END-DISPLAY
- END-IF
- MOVE FUNCTION TEST-FORMATTED-DATETIME
- ("YYYYMMDDThhmmss", SPACE)
- TO RESULT
- IF RESULT <> 1
- DISPLAY "Test 4 failed: " RESULT END-DISPLAY
- END-IF
- MOVE FUNCTION TEST-FORMATTED-DATETIME
- ("YYYYMMDDThhmmss", "16010101T ")
- TO RESULT
- IF RESULT <> 10
- DISPLAY "Test 5 failed: " RESULT END-DISPLAY
- END-IF
-
- STOP RUN
- .
-])
-
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
-
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION TEST-FORMATTED-DATETIME DP.COMMA])
-AT_KEYWORDS([functions])
-
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- ENVIRONMENT DIVISION.
- CONFIGURATION SECTION.
- SPECIAL-NAMES.
- DECIMAL-POINT IS COMMA.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- PROCEDURE DIVISION.
- IF FUNCTION TEST-FORMATTED-DATETIME
- ("hhmmss,ss", "000000,00") <> 0
- DISPLAY "Test 1 failed" END-DISPLAY
- END-IF
- IF FUNCTION TEST-FORMATTED-DATETIME
- ("YYYYMMDDThhmmss,ss", "16010101T000000,00") <> 0
- DISPLAY "Test 2 failed" END-DISPLAY
- END-IF
-
- IF FUNCTION TEST-FORMATTED-DATETIME
- ("hhmmss,ss", "000000.00") <> 7
- DISPLAY "Test 3 failed" END-DISPLAY
- END-IF
- IF FUNCTION TEST-FORMATTED-DATETIME
- ("YYYYMMDDThhmmss,ss", "16010101T000000.00") <> 16
- DISPLAY "Test 4 failed" END-DISPLAY
- END-IF
-
- STOP RUN
- .
-])
-
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
-
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION TEST-NUMVAL])
-AT_KEYWORDS([functions])
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- PROCEDURE DIVISION.
- IF FUNCTION TEST-NUMVAL ("+ 1") NOT = 0
- DISPLAY "Test 1 fail"
- END-DISPLAY
- END-IF.
- IF FUNCTION TEST-NUMVAL (" + 1") NOT = 0
- DISPLAY "Test 2 fail"
- END-DISPLAY
- END-IF.
- IF FUNCTION TEST-NUMVAL ("- 1") NOT = 0
- DISPLAY "Test 3 fail"
- END-DISPLAY
- END-IF.
- IF FUNCTION TEST-NUMVAL (" - 1") NOT = 0
- DISPLAY "Test 4 fail"
- END-DISPLAY
- END-IF.
- IF FUNCTION TEST-NUMVAL ("+- 1") NOT = 2
- DISPLAY "Test 5 fail"
- END-DISPLAY
- END-IF.
- IF FUNCTION TEST-NUMVAL ("1 +") NOT = 0
- DISPLAY "Test 6 fail"
- END-DISPLAY
- END-IF.
- IF FUNCTION TEST-NUMVAL ("1 -") NOT = 0
- DISPLAY "Test 7 fail"
- END-DISPLAY
- END-IF.
- IF FUNCTION TEST-NUMVAL ("1 +-") NOT = 4
- DISPLAY "Test 8 fail"
- END-DISPLAY
- END-IF.
- IF FUNCTION TEST-NUMVAL ("1 -+") NOT = 4
- DISPLAY "Test 9 fail"
- END-DISPLAY
- END-IF.
- IF FUNCTION TEST-NUMVAL ("+ 1.1") NOT = 0
- DISPLAY "Test 10 fail"
- END-DISPLAY
- END-IF.
- IF FUNCTION TEST-NUMVAL ("- 1.1") NOT = 0
- DISPLAY "Test 11 fail"
- END-DISPLAY
- END-IF.
- IF FUNCTION TEST-NUMVAL ("1.1 +") NOT = 0
- DISPLAY "Test 12 fail"
- END-DISPLAY
- END-IF.
- IF FUNCTION TEST-NUMVAL ("1.1 -") NOT = 0
- DISPLAY "Test 13 fail"
- END-DISPLAY
- END-IF.
- IF FUNCTION TEST-NUMVAL ("1.1 CR") NOT = 0
- DISPLAY "Test 14 fail"
- END-DISPLAY
- END-IF.
- IF FUNCTION TEST-NUMVAL ("1.1 DB") NOT = 0
- DISPLAY "Test 15 fail"
- END-DISPLAY
- END-IF.
- IF FUNCTION TEST-NUMVAL ("1.1 -CR") NOT = 6
- DISPLAY "Test 16 fail"
- END-DISPLAY
- END-IF.
- IF FUNCTION TEST-NUMVAL ("1.1 +DB") NOT = 6
- DISPLAY "Test 17 fail"
- END-DISPLAY
- END-IF.
- IF FUNCTION TEST-NUMVAL ("1.1 CDB") NOT = 6
- DISPLAY "Test 18 fail"
- END-DISPLAY
- END-IF.
- IF FUNCTION TEST-NUMVAL ("+1.1 CR") NOT = 6
- DISPLAY "Test 19 fail"
- END-DISPLAY
- END-IF.
- IF FUNCTION TEST-NUMVAL ("+ ") NOT = 8
- DISPLAY "Test 20 fail"
- END-DISPLAY
- END-IF.
- STOP RUN.
-])
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION TEST-NUMVAL-C])
-AT_KEYWORDS([functions])
-
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- PROCEDURE DIVISION.
- IF FUNCTION TEST-NUMVAL-C ("+ 1") NOT = 0
- DISPLAY "Test 1 fail"
- END-DISPLAY
- END-IF.
- IF FUNCTION TEST-NUMVAL-C (" + 1") NOT = 0
- DISPLAY "Test 2 fail"
- END-DISPLAY
- END-IF.
- IF FUNCTION TEST-NUMVAL-C ("- 1") NOT = 0
- DISPLAY "Test 3 fail"
- END-DISPLAY
- END-IF.
- IF FUNCTION TEST-NUMVAL-C (" - 1") NOT = 0
- DISPLAY "Test 4 fail"
- END-DISPLAY
- END-IF.
- IF FUNCTION TEST-NUMVAL-C ("+- 1") NOT = 2
- DISPLAY "Test 5 fail"
- END-DISPLAY
- END-IF.
- IF FUNCTION TEST-NUMVAL-C ("1 +") NOT = 0
- DISPLAY "Test 6 fail"
- END-DISPLAY
- END-IF.
- IF FUNCTION TEST-NUMVAL-C ("1 -") NOT = 0
- DISPLAY "Test 7 fail"
- END-DISPLAY
- END-IF.
- IF FUNCTION TEST-NUMVAL-C ("1 +-") NOT = 4
- DISPLAY "Test 8 fail"
- END-DISPLAY
- END-IF.
- IF FUNCTION TEST-NUMVAL-C ("1 -+") NOT = 4
- DISPLAY "Test 9 fail"
- END-DISPLAY
- END-IF.
- IF FUNCTION TEST-NUMVAL-C ("+ 1.1") NOT = 0
- DISPLAY "Test 10 fail"
- END-DISPLAY
- END-IF.
- IF FUNCTION TEST-NUMVAL-C ("- 1.1") NOT = 0
- DISPLAY "Test 11 fail"
- END-DISPLAY
- END-IF.
- IF FUNCTION TEST-NUMVAL-C ("1.1 +") NOT = 0
- DISPLAY "Test 12 fail"
- END-DISPLAY
- END-IF.
- IF FUNCTION TEST-NUMVAL-C ("1.1 -") NOT = 0
- DISPLAY "Test 13 fail"
- END-DISPLAY
- END-IF.
- IF FUNCTION TEST-NUMVAL-C ("1.1 CR") NOT = 0
- DISPLAY "Test 14 fail"
- END-DISPLAY
- END-IF.
- IF FUNCTION TEST-NUMVAL-C ("1.1 DB") NOT = 0
- DISPLAY "Test 15 fail"
- END-DISPLAY
- END-IF.
- IF FUNCTION TEST-NUMVAL-C ("1.1 -CR") NOT = 6
- DISPLAY "Test 16 fail"
- END-DISPLAY
- END-IF.
- IF FUNCTION TEST-NUMVAL-C ("+ $1.1 ") NOT = 0
- DISPLAY "Test 17 fail"
- END-DISPLAY
- END-IF.
- IF FUNCTION TEST-NUMVAL-C ("- $1.1 ") NOT = 0
- DISPLAY "Test 18 fail"
- END-DISPLAY
- END-IF.
- IF FUNCTION TEST-NUMVAL-C ("+ X1.1 ", "X") NOT = 0
- DISPLAY "Test 19 fail"
- END-DISPLAY
- END-IF.
- IF FUNCTION TEST-NUMVAL-C ("- X1.1 ", "X") NOT = 0
- DISPLAY "Test 20 fail"
- END-DISPLAY
- END-IF.
- STOP RUN.
-])
-
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
-AT_CLEANUP
-
-AT_SETUP([FUNCTION TEST-NUMVAL-F])
-AT_KEYWORDS([functions])
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- PROCEDURE DIVISION.
- IF FUNCTION TEST-NUMVAL-F ("+ 1") NOT = 0
- DISPLAY "Test 1 fail"
- END-DISPLAY
- END-IF.
- IF FUNCTION TEST-NUMVAL-F (" + 1") NOT = 0
- DISPLAY "Test 2 fail"
- END-DISPLAY
- END-IF.
- IF FUNCTION TEST-NUMVAL-F ("- 1") NOT = 0
- DISPLAY "Test 3 fail"
- END-DISPLAY
- END-IF.
- IF FUNCTION TEST-NUMVAL-F (" - 1") NOT = 0
- DISPLAY "Test 4 fail"
- END-DISPLAY
- END-IF.
- IF FUNCTION TEST-NUMVAL-F ("+- 1") NOT = 2
- DISPLAY "Test 5 fail"
- END-DISPLAY
- END-IF.
- IF FUNCTION TEST-NUMVAL-F ("1 +") NOT = 3
- DISPLAY "Test 6 fail"
- END-DISPLAY
- END-IF.
- IF FUNCTION TEST-NUMVAL-F ("1 -") NOT = 3
- DISPLAY "Test 7 fail"
- END-DISPLAY
- END-IF.
- IF FUNCTION TEST-NUMVAL-F ("1 +-") NOT = 3
- DISPLAY "Test 8 fail"
- END-DISPLAY
- END-IF.
- IF FUNCTION TEST-NUMVAL-F ("1 -+") NOT = 3
- DISPLAY "Test 9 fail"
- END-DISPLAY
- END-IF.
- IF FUNCTION TEST-NUMVAL-F ("+ 1.1") NOT = 0
- DISPLAY "Test 10 fail"
- END-DISPLAY
- END-IF.
- IF FUNCTION TEST-NUMVAL-F ("- 1.1") NOT = 0
- DISPLAY "Test 11 fail"
- END-DISPLAY
- END-IF.
- IF FUNCTION TEST-NUMVAL-F ("1.1 +") NOT = 5
- DISPLAY "Test 12 fail"
- END-DISPLAY
- END-IF.
- IF FUNCTION TEST-NUMVAL-F ("1.1 -") NOT = 5
- DISPLAY "Test 13 fail"
- END-DISPLAY
- END-IF.
- IF FUNCTION TEST-NUMVAL-F ("1.1 ") NOT = 0
- DISPLAY "Test 14 fail"
- END-DISPLAY
- END-IF.
- IF FUNCTION TEST-NUMVAL-F ("1.1 ") NOT = 0
- DISPLAY "Test 15 fail"
- END-DISPLAY
- END-IF.
- IF FUNCTION TEST-NUMVAL-F ("1.1 -CR") NOT = 5
- DISPLAY "Test 16 fail"
- END-DISPLAY
- END-IF.
- IF FUNCTION TEST-NUMVAL-F ("1.1 E+1") NOT = 0
- DISPLAY "Test 17 fail"
- END-DISPLAY
- END-IF.
- IF FUNCTION TEST-NUMVAL-F ("1.1 E -1") NOT = 0
- DISPLAY "Test 18 fail"
- END-DISPLAY
- END-IF.
- IF FUNCTION TEST-NUMVAL-F ("1.1 EE") NOT = 6
- DISPLAY "Test 19 fail"
- END-DISPLAY
- END-IF.
- IF FUNCTION TEST-NUMVAL-F ("+1.1 E+01") NOT = 0
- DISPLAY "Test 20 fail"
- END-DISPLAY
- END-IF.
- STOP RUN.
-])
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION TRIM])
-AT_KEYWORDS([functions])
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 X PIC X(12) VALUE " a#b.c%d+e$ ".
- PROCEDURE DIVISION.
- DISPLAY FUNCTION TRIM ( X )
- END-DISPLAY.
- DISPLAY FUNCTION TRIM ( X TRAILING )
- END-DISPLAY.
- STOP RUN.
-])
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0],
-[a#b.c%d+e$
- a#b.c%d+e$
-])
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION TRIM with reference modding])
-AT_KEYWORDS([functions])
-
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 X PIC X(12) VALUE " a#b.c%d+e$ ".
- PROCEDURE DIVISION.
- DISPLAY FUNCTION TRIM ( X ) (2 : 3)
- END-DISPLAY.
- DISPLAY FUNCTION TRIM ( X TRAILING ) (2 : 3)
- END-DISPLAY.
- STOP RUN.
-])
-
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0],
-[#b.
-a#b
-])
-
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION TRIM zero length])
-AT_KEYWORDS([functions])
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 A2 PIC X(2) VALUE " ".
- 01 A3 PIC X(3) VALUE " ".
- 01 X PIC X(4) VALUE "NOOK".
- PROCEDURE DIVISION.
- MOVE FUNCTION TRIM ( A2 ) TO X.
- DISPLAY ">" X "<"
- END-DISPLAY.
- DISPLAY ">" FUNCTION TRIM ( A3 ) "<"
- END-DISPLAY.
- STOP RUN.
-])
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0],
-[> <
-><
-])
-
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION UPPER-CASE])
-AT_KEYWORDS([functions])
-
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 X PIC X(10) VALUE "a#b.c%d+e$".
- 01 Z PIC X(10).
- PROCEDURE DIVISION.
- MOVE FUNCTION UPPER-CASE ( X ) TO Z.
- IF Z NOT = "A#B.C%D+E$"
- DISPLAY Z
- END-DISPLAY
- END-IF.
- STOP RUN.
-])
-
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
-
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION UPPER-CASE with reference modding])
-AT_KEYWORDS([functions])
-
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 X PIC X(10) VALUE "a#b.c%d+e$".
- 01 Z PIC X(4).
- PROCEDURE DIVISION.
- MOVE FUNCTION UPPER-CASE ( X ) (1 : 3) TO Z.
- IF Z NOT = "A#B "
- DISPLAY Z
- END-DISPLAY
- END-IF.
- STOP RUN.
-])
-
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
-
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION VARIANCE])
-AT_KEYWORDS([functions])
-
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 Z PIC S9(4)V9(4) COMP-5.
- PROCEDURE DIVISION.
- MOVE FUNCTION VARIANCE ( 3 -14 0 8 -3 ) TO Z.
- IF Z NOT = 54.16
- DISPLAY Z
- END-DISPLAY
- END-IF.
- STOP RUN.
-])
-
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
-
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION WHEN-COMPILED])
-AT_KEYWORDS([functions])
-
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 compiled-datetime.
- 03 compiled-date.
- 05 millennium PIC X.
- 05 FILLER PIC X(15).
- 03 timezone PIC X(5).
- PROCEDURE DIVISION.
- *> Check millennium.
- MOVE FUNCTION WHEN-COMPILED TO compiled-datetime.
- IF millennium NOT = "2"
- DISPLAY "Millennium NOT OK: " millennium
- END-DISPLAY
- END-IF.
-
- *> Check timezone.
- IF timezone NOT = FUNCTION CURRENT-DATE (17:5)
- DISPLAY "Timezone NOT OK: " timezone
- END-DISPLAY
- END-IF.
-
- *> Check date format.
- INSPECT compiled-date CONVERTING "0123456789"
- TO "9999999999".
- IF compiled-date NOT = ALL "9"
- DISPLAY "Date format NOT OK: " compiled-date
- END-DISPLAY
- END-IF.
-
- *> Check timezone format.
- IF timezone NOT = "00000"
- INSPECT timezone CONVERTING "0123456789"
- TO "9999999999"
- IF timezone NOT = "+9999" AND "-9999"
- DISPLAY "Timezone format NOT OK: " timezone
- END-DISPLAY
- END-IF
- END-IF.
-
- STOP RUN.
-])
-
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
-
-AT_CLEANUP
-
-
-AT_SETUP([FUNCTION YEAR-TO-YYYY])
-AT_KEYWORDS([functions])
-
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 Z USAGE BINARY-LONG.
- PROCEDURE DIVISION.
- MOVE FUNCTION YEAR-TO-YYYY ( 50 ) TO Z.
- IF Z NOT = 2050
- DISPLAY Z
- END-DISPLAY
- END-IF.
- STOP RUN.
-])
-
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
-
AT_CLEANUP
diff --git a/gcc/cobol/UAT/testsuite.at b/gcc/cobol/UAT/testsuite.at
index bac6ddf18e2e6038859f2f3d4fad215297bc8fcb..2b27be5d29c42408d0af83a569c4651056c1a693 100644
--- a/gcc/cobol/UAT/testsuite.at
+++ b/gcc/cobol/UAT/testsuite.at
@@ -48,9 +48,8 @@ m4_include([run_evaluate.at])
AT_BANNER([FILE])
m4_include([run_file.at])
-# functions DEFERRED
-# AT_BANNER([FUNCTIONS])
-# m4_include([functions.at])
+AT_BANNER([FUNCTIONS])
+m4_include([run_functions.at])
AT_BANNER([FUNDAMENTAL])
m4_include([run_fundamental.at])
diff --git a/gcc/cobol/UAT/testsuite.src/run_functions.at b/gcc/cobol/UAT/testsuite.src/run_functions.at
new file mode 100644
index 0000000000000000000000000000000000000000..b1b7ce6bae5c344dfb25a360457bada0c78535d2
--- /dev/null
+++ b/gcc/cobol/UAT/testsuite.src/run_functions.at
@@ -0,0 +1,3497 @@
+## Copyright (C) 2003-2012, 2014-2020 Free Software Foundation, Inc.
+## Written by Keisuke Nishida, Roger While, Simon Sobisch, Edward Hart
+##
+## This file is part of GnuCOBOL.
+##
+## The GnuCOBOL compiler is free software: you can redistribute it
+## and/or modify it under the terms of the GNU General Public License
+## as published by the Free Software Foundation, either version 3 of the
+## License, or (at your option) any later version.
+##
+## GnuCOBOL is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with GnuCOBOL. If not, see <https://www.gnu.org/licenses/>.
+
+### GnuCOBOL Test Suite
+
+### ISO+IEC+1989-2002 15 Intrinsic Functions
+### ISO+IEC+1989-2002 9.4 User-Defined Functions
+
+AT_SETUP([FUNCTION ABS])
+AT_KEYWORDS([functions])
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 X PIC S9(4)V9(4) VALUE -1.2345.
+ PROCEDURE DIVISION.
+ COMPUTE X = FUNCTION ABS( X )
+ DISPLAY X
+ END-DISPLAY.
+ STOP RUN.
+])
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0],
+[+0001.2345
+])
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION ACOS])
+AT_KEYWORDS([functions])
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 Z PIC S9V9(33).
+ PROCEDURE DIVISION.
+ MOVE FUNCTION ACOS ( -0.2345 ) TO Z.
+ IF Z NOT = 1.807500521108243435101500438523210
+ DISPLAY Z
+ END-DISPLAY
+ END-IF.
+ STOP RUN.
+])
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION ANNUITY])
+AT_KEYWORDS([functions])
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 Z PIC S9V9(33).
+ PROCEDURE DIVISION.
+ MOVE FUNCTION ANNUITY ( 3, 5 ) TO Z.
+ IF Z NOT = 3.002932551319648093841642228739002
+ DISPLAY Z
+ END-DISPLAY
+ END-IF.
+ STOP RUN.
+])
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION ASIN])
+AT_KEYWORDS([functions])
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 Y PIC S9V9(33).
+ PROCEDURE DIVISION.
+ MOVE FUNCTION ASIN ( -0.2345 ) TO Y.
+ IF Y NOT = -0.236704194313346815870178746883458
+ DISPLAY Y
+ END-DISPLAY
+ END-IF.
+ STOP RUN.
+])
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION ATAN])
+AT_KEYWORDS([functions])
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 Y PIC S9V9(33).
+ PROCEDURE DIVISION.
+ MOVE FUNCTION ATAN ( 1 ) TO Y.
+ IF Y NOT = 0.785398163397448309615660845819875
+ DISPLAY Y
+ END-DISPLAY
+ END-IF.
+ STOP RUN.
+])
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION BYTE-LENGTH])
+AT_KEYWORDS([functions length])
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 X PIC X(4).
+ 01 TEST-FLD PIC S9(04)V9(08).
+ PROCEDURE DIVISION.
+ MOVE FUNCTION BYTE-LENGTH ( TEST-FLD ) TO TEST-FLD.
+ DISPLAY "BYTE-LENGTH of PIC S9(04)V9(08) is " TEST-FLD
+ MOVE FUNCTION BYTE-LENGTH ( X ) TO TEST-FLD.
+ DISPLAY "BYTE-LENGTH of PIC X(4) is " TEST-FLD
+ MOVE FUNCTION BYTE-LENGTH ( '00128' ) TO TEST-FLD
+ DISPLAY "BYTE-LENGTH of PIC '00128' is " TEST-FLD
+ MOVE FUNCTION BYTE-LENGTH ( x'a0' ) TO TEST-FLD
+ DISPLAY "BYTE-LENGTH of PIC x'a0' is " TEST-FLD
+ STOP RUN.
+])
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [BYTE-LENGTH of PIC S9(04)V9(08) is +0012.00000000
+BYTE-LENGTH of PIC X(4) is +0004.00000000
+BYTE-LENGTH of PIC '00128' is +0005.00000000
+BYTE-LENGTH of PIC x'a0' is +0001.00000000
+], [])
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION CHAR])
+AT_KEYWORDS([functions])
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 X PIC S9(4)V9(4) VALUE 108.
+ 01 TEST-FLD.
+ 05 TEST-DATA PIC X(01).
+ 88 VALID-DATA VALUE 'k'.
+ 05 TEST-UNSET PIC X VALUE '_'.
+ 88 VALID-UNSET VALUE '_'.
+ PROCEDURE DIVISION.
+ STRING FUNCTION CHAR ( X )
+ DELIMITED BY SIZE
+ INTO TEST-FLD
+ END-STRING.
+ EVALUATE TRUE
+ WHEN NOT VALID-UNSET
+ DISPLAY "FUNCTION result too long"
+ END-DISPLAY
+ WHEN VALID-DATA
+ CONTINUE
+ WHEN OTHER
+ DISPLAY TEST-DATA
+ END-DISPLAY
+ END-EVALUATE.
+ STOP RUN.
+])
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION COMBINED-DATETIME])
+AT_KEYWORDS([functions])
+
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 TEST-FLD PIC S9(04)V9(08).
+ PROCEDURE DIVISION.
+ MOVE FUNCTION COMBINED-DATETIME ( 987, 345.6 )
+ TO TEST-FLD.
+ IF TEST-FLD NOT = 987.003456
+ DISPLAY TEST-FLD
+ END-DISPLAY
+ END-IF.
+ STOP RUN.
+])
+
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION CONCAT / CONCATENATE])
+AT_KEYWORDS([functions])
+
+# note: CONCAT was added in COBOL 202x with GnuCOBOL's CONCATENATE
+# as blueprint
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 Y PIC X(4).
+ 01 TEST-FLD.
+ 05 TEST-DATA PIC X(14).
+ 88 VALID-DATA VALUE 'defxabczz55666'.
+ 05 TEST-UNSET PIC X VALUE '_'.
+ 88 VALID-UNSET VALUE '_'.
+ PROCEDURE DIVISION.
+ MOVE "defx" TO Y.
+ STRING FUNCTION CONCAT ( Y "abc" "zz" "55" "666" )
+ DELIMITED BY SIZE
+ INTO TEST-FLD
+ END-STRING.
+ EVALUATE TRUE
+ WHEN NOT VALID-UNSET
+ DISPLAY "FUNCTION result too long"
+ END-DISPLAY
+ WHEN TEST-DATA
+ <> FUNCTION CONCAT ( Y "abc" "zz" "55" "666" )
+ DISPLAY "CONCAT issue, '" TEST-DATA
+ "' vs. '"
+ FUNCTION CONCAT ( Y "abc" "zz" "55" "666" ) "'"
+ END-DISPLAY
+ WHEN VALID-DATA
+ CONTINUE
+ WHEN OTHER
+ DISPLAY TEST-DATA
+ END-DISPLAY
+ END-EVALUATE.
+ STOP RUN.
+])
+
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION CONCAT with reference modding])
+AT_KEYWORDS([functions])
+
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 Y PIC X(4).
+ 01 TEST-FLD PIC X(9) VALUE SPACES.
+ PROCEDURE DIVISION.
+ MOVE 'defx' TO Y.
+ MOVE FUNCTION CONCAT
+ ( Y "abc" "zz" "55" "666" ) (2 : 9)
+ TO TEST-FLD.
+ IF TEST-FLD NOT = 'efxabczz5'
+ DISPLAY TEST-FLD
+ END-DISPLAY
+ END-IF.
+ STOP RUN.
+])
+
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+AT_CLEANUP
+
+
+
+# Invalid test.
+# prog.cob:18: ANY LENGTH valid only for 01 in LIKAGE SECTION of a contained program
+# "subprog", so called, is not contained.
+
+AT_SETUP([FUNCTION as CALL parameter BY CONTENT])
+AT_KEYWORDS([functions])
+
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+
+ PROCEDURE DIVISION.
+ PROG-MAIN.
+ CALL "subprog" USING BY CONTENT
+ FUNCTION CONCAT("Abc" "D")
+ STOP RUN.
+
+ *> *****************************
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. subprog.
+
+ DATA DIVISION.
+ LINKAGE SECTION.
+ 01 TESTING PIC X ANY LENGTH.
+
+ PROCEDURE DIVISION USING TESTING.
+ SUBPROG-MAIN.
+ DISPLAY TESTING
+ GOBACK.
+ END PROGRAM subprog.
+ END PROGRAM prog. *> bzzt
+])
+
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [AbcD
+], [])
+
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION COS])
+AT_KEYWORDS([functions])
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 Y PIC S9V9(33).
+ PROCEDURE DIVISION.
+ MOVE FUNCTION COS ( -0.2345 ) TO Y.
+ IF Y NOT = 0.972630641256258184713416962414561
+ DISPLAY Y
+ END-DISPLAY
+ END-IF.
+ STOP RUN.
+])
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION CURRENT-DATE])
+AT_KEYWORDS([functions])
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ ENVIRONMENT DIVISION.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 TEST-FLD.
+ 02 WS-YEAR PIC 9(04).
+ 88 VALID-YEAR VALUE 1980 THRU 9999.
+ 02 WS-MONTH PIC 9(02).
+ 88 VALID-MONTH VALUE 01 THRU 12.
+ 02 WS-DAY PIC 9(02).
+ 88 VALID-DAY VALUE 01 THRU 31.
+ 02 WS-HOUR PIC 9(02).
+ 88 VALID-HOUR VALUE 00 THRU 23.
+ 02 WS-MIN PIC 9(02).
+ 88 VALID-MIN VALUE 00 THRU 59.
+ 02 WS-SEVALIDD PIC 9(02).
+ 88 VALID-SEC VALUE 00 THRU 59.
+ 02 WS-HUNDSEC PIC 9(02).
+ 88 VALID-HUNDSEC VALUE 00 THRU 99.
+ 02 WS-GREENW PIC X.
+ 88 VALID-GREENW VALUE "-", "+", "0".
+ 88 ZERO-GREENW VALUE "0".
+ 02 WS-OFFSET PIC 9(02).
+ 88 VALID-OFFSET VALUE 00 THRU 13.
+ 88 ZERO-OFFSET VALUE 00.
+ 02 WS-OFFSET2 PIC 9(02).
+ 88 VALID-OFFSET2 VALUE 00 THRU 59.
+ 88 ZERO-OFFSET2 VALUE 00.
+ 02 WS-UNSET PIC X VALUE '_'.
+ 88 VALID-UNSET VALUE '_'.
+ PROCEDURE DIVISION.
+ STRING FUNCTION CURRENT-DATE
+ DELIMITED BY SIZE
+ INTO TEST-FLD
+ END-STRING.
+ EVALUATE TRUE
+ WHEN NOT VALID-UNSET
+ DISPLAY "FUNCTION result too long"
+ END-DISPLAY
+ WHEN VALID-YEAR AND
+ VALID-MONTH AND
+ VALID-DAY AND
+ VALID-HOUR AND
+ VALID-MIN AND
+ VALID-SEC AND
+ VALID-HUNDSEC AND
+ VALID-GREENW AND
+ VALID-OFFSET AND
+ VALID-OFFSET2 AND
+ VALID-UNSET AND
+ ((NOT ZERO-GREENW) OR (ZERO-OFFSET AND ZERO-OFFSET2))
+ CONTINUE
+ WHEN OTHER
+ DISPLAY "CURRENT-DATE with wrong format: "
+ TEST-FLD (01:21)
+ END-DISPLAY
+ END-EVALUATE.
+ STOP RUN.
+])
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION DATE-OF-INTEGER])
+AT_KEYWORDS([functions])
+
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 TEST-FLD PIC S9(09)V9(02).
+ PROCEDURE DIVISION.
+ MOVE FUNCTION DATE-OF-INTEGER ( 146000 )
+ TO TEST-FLD.
+ IF TEST-FLD NOT = 20000925
+ DISPLAY TEST-FLD
+ END-DISPLAY
+ END-IF.
+ STOP RUN.
+])
+
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION DATE-TO-YYYYMMDD])
+AT_KEYWORDS([functions])
+
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 TEST-FLD PIC S9(09)V9(02).
+ PROCEDURE DIVISION.
+ MOVE FUNCTION DATE-TO-YYYYMMDD ( 981002, -10, 1994 )
+ TO TEST-FLD.
+ IF TEST-FLD NOT = 018981002
+ DISPLAY TEST-FLD
+ END-DISPLAY
+ END-IF.
+ STOP RUN.
+])
+
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION DAY-OF-INTEGER])
+AT_KEYWORDS([functions])
+
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 TEST-FLD PIC S9(09)V9(02).
+ PROCEDURE DIVISION.
+ MOVE FUNCTION DAY-OF-INTEGER ( 146000 )
+ TO TEST-FLD.
+ IF TEST-FLD NOT = 2000269
+ DISPLAY TEST-FLD
+ END-DISPLAY
+ END-IF.
+ STOP RUN.
+])
+
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION DAY-TO-YYYYDDD])
+AT_KEYWORDS([functions])
+
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 TEST-FLD PIC S9(09)V9(02).
+ PROCEDURE DIVISION.
+ MOVE FUNCTION DAY-TO-YYYYDDD ( 95005, -10, 2013 )
+ TO TEST-FLD.
+ IF TEST-FLD NOT = 001995005
+ DISPLAY TEST-FLD
+ END-DISPLAY
+ END-IF.
+ STOP RUN.
+])
+
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION E])
+AT_KEYWORDS([functions])
+
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 Y PIC 9V9(33).
+ PROCEDURE DIVISION.
+ MOVE FUNCTION E TO Y.
+ IF Y NOT = 2.718281828459045235360287471352662
+ DISPLAY Y
+ END-DISPLAY
+ END-IF.
+ STOP RUN.
+])
+
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION EXCEPTION-FILE])
+AT_KEYWORDS([functions exceptions])
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ ENVIRONMENT DIVISION.
+ INPUT-OUTPUT SECTION.
+ FILE-CONTROL.
+ SELECT TEST-FILE ASSIGN "NOTEXIST"
+ FILE STATUS IS TEST-STATUS.
+ DATA DIVISION.
+ FILE SECTION.
+ FD TEST-FILE.
+ 01 TEST-REC PIC X(4).
+ WORKING-STORAGE SECTION.
+ 01 TEST-STATUS PIC XX.
+ PROCEDURE DIVISION.
+ DISPLAY FUNCTION EXCEPTION-FILE '|'
+ NO ADVANCING
+ END-DISPLAY.
+ OPEN INPUT TEST-FILE.
+ DISPLAY FUNCTION EXCEPTION-FILE
+ NO ADVANCING
+ END-DISPLAY.
+ STOP RUN.
+])
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0],
+[00|35TEST-FILE], [])
+
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION EXCEPTION-LOCATION])
+AT_KEYWORDS([functions exceptions])
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ ENVIRONMENT DIVISION.
+ INPUT-OUTPUT SECTION.
+ FILE-CONTROL.
+ SELECT TEST-FILE ASSIGN "NOTEXIST"
+ FILE STATUS IS TEST-STATUS.
+ DATA DIVISION.
+ FILE SECTION.
+ FD TEST-FILE.
+ 01 TEST-REC PIC X(4).
+ WORKING-STORAGE SECTION.
+ 01 TEST-STATUS PIC XX.
+ PROCEDURE DIVISION.
+ DECLARATIVES.
+ EC-ALL-SECTION SECTION.
+ USE EC EC-ALL
+ RESUME NEXT STATEMENT.
+ END DECLARATIVES.
+ A00-MAIN SECTION.
+ A00.
+ SET LAST EXCEPTION TO OFF
+ DISPLAY "EXCEPTION-LOCATION before open attempt: "
+ """" FUNCTION EXCEPTION-LOCATION """".
+ B00-MAIN SECTION.
+ B00.
+ SET LAST EXCEPTION TO OFF
+ OPEN INPUT TEST-FILE.
+ DISPLAY "EXCEPTION-LOCATION after open attempt: "
+ """" FUNCTION EXCEPTION-LOCATION """".
+ C00-MAIN SECTION.
+ C00.
+ >>TURN EC-ALL CHECKING ON
+ SET LAST EXCEPTION TO OFF
+ OPEN INPUT TEST-FILE.
+ DISPLAY "EXCEPTION-LOCATION after CHECKED open attempt: "
+ """" FUNCTION EXCEPTION-LOCATION """".
+ STOP RUN.
+])
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0],
+[EXCEPTION-LOCATION before open attempt: " "
+EXCEPTION-LOCATION after open attempt: "prog; B00 OF B00-MAIN; prog.cob:29 "
+EXCEPTION-LOCATION after CHECKED open attempt: "prog; C00 OF C00-MAIN; prog.cob:36 "
+], [])
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION EXCEPTION-STATEMENT])
+AT_KEYWORDS([functions exceptions])
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ ENVIRONMENT DIVISION.
+ INPUT-OUTPUT SECTION.
+ FILE-CONTROL.
+ SELECT TEST-FILE ASSIGN "NOTEXIST"
+ FILE STATUS IS TEST-STATUS.
+ DATA DIVISION.
+ FILE SECTION.
+ FD TEST-FILE.
+ 01 TEST-REC PIC X(4).
+ WORKING-STORAGE SECTION.
+ 01 TEST-STATUS PIC XX.
+ PROCEDURE DIVISION.
+ DISPLAY "EXCEPTION-STATEMENT before bad OPEN: "
+ """" FUNCTION EXCEPTION-STATEMENT """"
+ OPEN INPUT TEST-FILE.
+ DISPLAY "EXCEPTION-STATEMENT after bad OPEN: "
+ """" FUNCTION EXCEPTION-STATEMENT """"
+ STOP RUN.
+])
+
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0],
+[EXCEPTION-STATEMENT before bad OPEN: " "
+EXCEPTION-STATEMENT after bad OPEN: "OPEN"
+], [])
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION EXCEPTION-STATUS])
+AT_KEYWORDS([functions exceptions])
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ ENVIRONMENT DIVISION.
+ INPUT-OUTPUT SECTION.
+ FILE-CONTROL.
+ SELECT TEST-FILE ASSIGN "NOTEXIST"
+ FILE STATUS IS TEST-STATUS.
+ DATA DIVISION.
+ FILE SECTION.
+ FD TEST-FILE.
+ 01 TEST-REC PIC X(4).
+ WORKING-STORAGE SECTION.
+ 01 TEST-STATUS PIC XX.
+ PROCEDURE DIVISION.
+ DISPLAY "EXCEPTION STATUS before bad open: "
+ """" FUNCTION EXCEPTION-STATUS """"
+ OPEN INPUT TEST-FILE.
+ DISPLAY "EXCEPTION STATUS after bad open: "
+ """" FUNCTION EXCEPTION-STATUS """"
+ STOP RUN.
+])
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0],
+[EXCEPTION STATUS before bad open: " "
+EXCEPTION STATUS after bad open: "EC-I-O-PERMANENT-ERROR"
+], [])
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION EXP])
+AT_KEYWORDS([functions])
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 Y PIC S99V9(31).
+ PROCEDURE DIVISION.
+ MOVE FUNCTION EXP ( 3 ) TO Y.
+ IF Y NOT = 20.0855369231876677409285296545817
+ DISPLAY Y
+ END-DISPLAY
+ END-IF.
+ STOP RUN.
+])
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION EXP10])
+AT_KEYWORDS([functions])
+
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 TEST-FLD PIC S9(09)V9(02).
+ PROCEDURE DIVISION.
+ MOVE FUNCTION EXP10 ( 4 )
+ TO TEST-FLD.
+ IF TEST-FLD NOT = 000010000
+ DISPLAY TEST-FLD
+ END-DISPLAY
+ END-IF.
+ STOP RUN.
+])
+
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION FACTORIAL])
+AT_KEYWORDS([functions])
+
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 TEST-FLD PIC S9(09)V9(02).
+ PROCEDURE DIVISION.
+ MOVE FUNCTION FACTORIAL ( 6 )
+ TO TEST-FLD.
+ IF TEST-FLD NOT = 000000720
+ DISPLAY TEST-FLD
+ END-DISPLAY
+ END-IF.
+ STOP RUN.
+])
+
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION FORMATTED-CURRENT-DATE])
+AT_KEYWORDS([functions])
+
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 Datetime-Format CONSTANT "YYYYMMDDThhmmss.ss+hhmm".
+ 01 str PIC X(25).
+ PROCEDURE DIVISION.
+ *> Test normal inputs.
+ MOVE FUNCTION FORMATTED-CURRENT-DATE ( Datetime-Format )
+ TO str
+ IF FUNCTION TEST-FORMATTED-DATETIME ( Datetime-Format, str)
+ <> 0
+ DISPLAY "Test 1 failed: " str END-DISPLAY
+ END-IF.
+
+ STOP RUN.
+])
+
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION FORMATTED-DATE])
+AT_KEYWORDS([functions])
+
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 str PIC X(10).
+ PROCEDURE DIVISION.
+ *> Test normal inputs.
+ MOVE FUNCTION FORMATTED-DATE ( "YYYYMMDD", 1 ) TO str
+ IF str <> "16010101"
+ DISPLAY "Test 1 failed: " str END-DISPLAY
+ END-IF
+
+ MOVE FUNCTION FORMATTED-DATE ( "YYYY-MM-DD", 1 ) TO str
+ IF str <> "1601-01-01"
+ DISPLAY "Test 2 failed: " str END-DISPLAY
+ END-IF
+
+ MOVE FUNCTION FORMATTED-DATE ( "YYYYDDD", 1 ) TO str
+ IF str <> "1601001"
+ DISPLAY "Test 3 failed: " str END-DISPLAY
+ END-IF
+
+ MOVE FUNCTION FORMATTED-DATE ( "YYYY-DDD", 1 ) TO str
+ IF str <> "1601-001"
+ DISPLAY "Test 4 failed: " str END-DISPLAY
+ END-IF
+
+ MOVE FUNCTION FORMATTED-DATE ( "YYYYWwwD", 1 ) TO str
+ IF str <> "1601W011"
+ DISPLAY "Test 5 failed: " str END-DISPLAY
+ END-IF
+
+ MOVE FUNCTION FORMATTED-DATE ( "YYYY-Www-D", 1 ) TO str
+ IF str <> "1601-W01-1"
+ DISPLAY "Test 6 failed: " str END-DISPLAY
+ END-IF
+
+ *> Test week number edge cases.
+ *> For 2012-01-01.
+ MOVE FUNCTION FORMATTED-DATE ( "YYYYWwwD", 150115 ) TO str
+ IF str <> "2011W527"
+ DISPLAY "Test 7 failed: " str END-DISPLAY
+ END-IF
+
+ *> and for 2013-12-30.
+ MOVE FUNCTION FORMATTED-DATE ( "YYYYWwwD", 150844 ) TO str
+ IF str <> "2014W011"
+ DISPLAY "Test 8 failed: " str END-DISPLAY
+ END-IF
+
+ STOP RUN.
+])
+
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION FORMATTED-DATE with ref modding])
+AT_KEYWORDS([functions])
+
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 str PIC X(04).
+ PROCEDURE DIVISION.
+ MOVE FUNCTION FORMATTED-DATE ("YYYYMMDD", 1) (3:4)
+ TO STR
+ IF STR NOT = '0101'
+ DISPLAY STR
+ END-DISPLAY
+ END-IF
+ STOP RUN.
+])
+
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION FORMATTED-DATETIME])
+AT_KEYWORDS([functions])
+
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 str PIC X(40).
+ PROCEDURE DIVISION.
+ *> Test normal inputs.
+ MOVE FUNCTION FORMATTED-DATETIME
+ ("YYYYMMDDThhmmss", 1, 45296)
+ TO str
+ IF str <> "16010101T123456"
+ DISPLAY "Test 1 failed: " str END-DISPLAY
+ END-IF
+
+ MOVE FUNCTION FORMATTED-DATETIME
+ ("YYYY-MM-DDThh:mm:ss", 1, 45296)
+ TO str
+ IF str <> "1601-01-01T12:34:56"
+ DISPLAY "Test 2 failed: " str END-DISPLAY
+ END-IF
+
+ MOVE FUNCTION FORMATTED-DATETIME
+ ("YYYYDDDThhmmss+hhmm", 1, 45296, -754)
+ TO str
+ IF str <> "1601001T123456-1234"
+ DISPLAY "Test 3 failed: " str END-DISPLAY
+ END-IF
+
+ MOVE FUNCTION FORMATTED-DATETIME
+ ("YYYYDDDThhmmss+hhmm", 1, 45296)
+ TO str
+ IF str <> "1601001T123456+0000"
+ DISPLAY "Test 4 failed: " str END-DISPLAY
+ END-IF
+
+ *> Test underflow to next day due to offset
+ MOVE FUNCTION FORMATTED-DATETIME
+ ("YYYYDDDThhmmss.sssssssssZ", 150846, 0,
+ 1)
+ TO str
+ IF str <> "2013365T235900.000000000Z"
+ DISPLAY "Test 5 failed: " str END-DISPLAY
+ END-IF
+
+ STOP RUN.
+])
+
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION FORMATTED-DATETIME with ref modding])
+AT_KEYWORDS([functions])
+
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 str PIC X(04).
+ PROCEDURE DIVISION.
+ MOVE FUNCTION FORMATTED-DATETIME
+ ("YYYYMMDDThhmmss", 1, 1) (3:4)
+ TO STR
+ IF STR NOT = '0101'
+ DISPLAY STR
+ END-DISPLAY
+ END-IF
+ STOP RUN.
+])
+
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION FORMATTED-TIME])
+AT_KEYWORDS([functions])
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 str PIC X(20).
+ PROCEDURE DIVISION.
+ *> Test normal inputs.
+ MOVE FUNCTION FORMATTED-TIME ( "hhmmss", 45296 ) TO str
+ IF str <> "123456"
+ DISPLAY "Test 1 failed: " str END-DISPLAY
+ END-IF
+
+ MOVE FUNCTION FORMATTED-TIME ( "hh:mm:ss", 45296 ) TO str
+ IF str <> "12:34:56"
+ DISPLAY "Test 2 failed: " str END-DISPLAY
+ END-IF
+
+ MOVE FUNCTION FORMATTED-TIME ( "hhmmssZ", 86399, -1 ) TO str
+ IF str <> "000059Z"
+ DISPLAY "Test 3 failed: " str END-DISPLAY
+ END-IF
+
+ MOVE FUNCTION FORMATTED-TIME ( "hh:mm:ssZ", 45296)
+ TO str
+ IF str <> "12:34:56Z"
+ DISPLAY "Test 4 failed: " str END-DISPLAY
+ END-IF
+
+ MOVE FUNCTION FORMATTED-TIME ( "hhmmss.ss", 45296.78 ) TO str
+ IF str <> "123456.78"
+ DISPLAY "Test 5 failed: " str END-DISPLAY
+ END-IF
+
+ MOVE FUNCTION FORMATTED-TIME ( "hh:mm:ss.ssZ", 0, 120)
+ TO str
+ IF str <> "22:00:00.00Z"
+ DISPLAY "Test 6 failed: " str END-DISPLAY
+ END-IF
+
+ MOVE FUNCTION FORMATTED-TIME ( "hhmmss+hhmm", 45296)
+ TO str
+ IF str <> "123456+0000"
+ DISPLAY "Test 7 failed: " str END-DISPLAY
+ END-IF
+
+ MOVE FUNCTION FORMATTED-TIME ( "hh:mm:ss+hh:mm", 45296, 0 )
+ TO str
+ IF str <> "12:34:56+00:00"
+ DISPLAY "Test 8 failed: " str END-DISPLAY
+ END-IF
+
+ MOVE FUNCTION FORMATTED-TIME ( "hhmmss+hhmm", 45296, -754)
+ TO str
+ IF str <> "123456-1234"
+ DISPLAY "Test 9 failed: " str END-DISPLAY
+ END-IF
+
+ *> Test with invalid/missing offset times.
+ MOVE FUNCTION FORMATTED-TIME ( "hhmmss+hhmm", 1, 3000 )
+ TO str
+ DISPLAY "Test 10 " """" str """"
+ DISPLAY "Test 10 " """" FUNCTION EXCEPTION-STATUS """"
+ DISPLAY "Test 10 " """" FUNCTION EXCEPTION-LOCATION """"
+
+ MOVE FUNCTION FORMATTED-TIME ( "hhmmss+hhmm", 1, -3000 )
+ TO str
+ DISPLAY "Test 11 " """" str """"
+ DISPLAY "Test 11 " """" FUNCTION EXCEPTION-STATUS """"
+ DISPLAY "Test 11 " """" FUNCTION EXCEPTION-LOCATION """"
+
+ STOP RUN.
+])
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [Test 10 " "
+Test 10 "EC-ARGUMENT-FUNCTION"
+Test 10 "prog; ; prog.cob:60 "
+Test 11 " "
+Test 11 "EC-ARGUMENT-FUNCTION"
+Test 11 "prog; ; prog.cob:66 "
+], [])
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION FORMATTED-TIME DP.COMMA])
+AT_KEYWORDS([functions])
+
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+
+ ENVIRONMENT DIVISION.
+ CONFIGURATION SECTION.
+ SPECIAL-NAMES.
+ DECIMAL-POINT IS COMMA.
+
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 str PIC X(11).
+
+ PROCEDURE DIVISION.
+ MOVE FUNCTION FORMATTED-TIME ("hh:mm:ss,ss", 45296) TO str
+ IF str <> "12:34:56,00"
+ DISPLAY "Test 1 failed: " str END-DISPLAY
+ END-IF
+
+ STOP RUN.
+])
+
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION FORMATTED-TIME with ref modding])
+AT_KEYWORDS([functions])
+
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 str PIC X(04).
+ PROCEDURE DIVISION.
+ MOVE FUNCTION FORMATTED-TIME ("hhmmss", 45296) (3:4)
+ TO STR
+ IF STR NOT = '3456'
+ DISPLAY STR
+ END-DISPLAY
+ END-IF
+ STOP RUN.
+])
+
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION FRACTION-PART])
+AT_KEYWORDS([functions])
+
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 TEST-FLD PIC S9(04)V9(04).
+ PROCEDURE DIVISION.
+ MOVE FUNCTION FRACTION-PART ( 3.12345 )
+ TO TEST-FLD.
+ IF TEST-FLD NOT = +0000.1234
+ DISPLAY 'FRACTION-PART ( +3.12345 ) wrong: ' TEST-FLD
+ END-DISPLAY
+ END-IF.
+ MOVE FUNCTION FRACTION-PART ( -3.12345 )
+ TO TEST-FLD.
+ IF TEST-FLD NOT = -0000.1234
+ DISPLAY 'FRACTION-PART ( -3.12345 ) wrong: ' TEST-FLD
+ END-DISPLAY
+ END-IF.
+ STOP RUN.
+])
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+AT_CLEANUP
+
+AT_SETUP([FUNCTION HEX-OF])
+AT_KEYWORDS([functions])
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 PAC PIC 9(5) COMP-3 VALUE 12345.
+ PROCEDURE DIVISION.
+ DISPLAY FUNCTION HEX-OF('Hello, world!')
+ DISPLAY FUNCTION HEX-OF(PAC)
+ END PROGRAM prog.
+])
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [48656C6C6F2C20776F726C6421
+12345F
+], [])
+AT_CLEANUP
+
+AT_SETUP([FUNCTION HIGHEST-ALGEBRAIC])
+AT_KEYWORDS([functions])
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 F1 PIC S999.
+ 01 F2 PIC S9(4) BINARY.
+ 01 F3 PIC 99V9(3).
+ 01 F4 PIC $**,**9.99BCR.
+ 01 F5 PIC $**,**9.99.
+ 01 F6 USAGE BINARY-CHAR SIGNED.
+ 01 F7 USAGE BINARY-CHAR UNSIGNED.
+ 01 F8 PIC 999PPP.
+ 01 F9 PIC P99.
+ 01 TEST-FLD PIC S9(08)V9(04).
+ PROCEDURE DIVISION.
+ MOVE FUNCTION HIGHEST-ALGEBRAIC (F1)
+ TO TEST-FLD.
+ IF TEST-FLD NOT = 999
+ DISPLAY "Test 1 fail: " TEST-FLD
+ END-DISPLAY
+ END-IF.
+ MOVE FUNCTION HIGHEST-ALGEBRAIC (F2)
+ TO TEST-FLD.
+ IF TEST-FLD NOT = 9999
+ DISPLAY "Test 2 fail: " TEST-FLD
+ END-DISPLAY
+ END-IF.
+ MOVE FUNCTION HIGHEST-ALGEBRAIC (F3)
+ TO TEST-FLD.
+ IF TEST-FLD NOT = 99.999
+ DISPLAY "Test 3 fail: " TEST-FLD
+ END-DISPLAY
+ END-IF.
+ MOVE FUNCTION HIGHEST-ALGEBRAIC (F4)
+ TO TEST-FLD.
+ IF TEST-FLD NOT = 99999.99
+ DISPLAY "Test 4 fail: " TEST-FLD
+ END-DISPLAY
+ END-IF.
+ MOVE FUNCTION HIGHEST-ALGEBRAIC (F5)
+ TO TEST-FLD.
+ IF TEST-FLD NOT = 99999.99
+ DISPLAY "Test 5 fail: " TEST-FLD
+ END-DISPLAY
+ END-IF.
+ MOVE FUNCTION HIGHEST-ALGEBRAIC (F6)
+ TO TEST-FLD.
+ IF TEST-FLD NOT = 127
+ DISPLAY "Test 6 fail: " TEST-FLD
+ END-DISPLAY
+ END-IF.
+ MOVE FUNCTION HIGHEST-ALGEBRAIC (F7)
+ TO TEST-FLD.
+ IF TEST-FLD NOT = 255
+ DISPLAY "Test 7 fail: " TEST-FLD
+ END-DISPLAY
+ END-IF.
+
+ MOVE FUNCTION HIGHEST-ALGEBRAIC (F8)
+ TO TEST-FLD.
+ IF TEST-FLD NOT = 999000
+ DISPLAY "Test 7 fail: " TEST-FLD
+ END-DISPLAY
+ END-IF.
+
+ MOVE FUNCTION HIGHEST-ALGEBRAIC (F9)
+ TO TEST-FLD.
+ IF TEST-FLD NOT = 0.099
+ DISPLAY "Test 7 fail: " TEST-FLD
+ END-DISPLAY
+ END-IF.
+
+ STOP RUN.
+])
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+AT_CLEANUP
+
+AT_SETUP([FUNCTION INTEGER])
+AT_KEYWORDS([functions])
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 X PIC S9(4)V9(4) VALUE -1.5.
+ 01 Y PIC 9(12) VALUE 600851475143.
+ 01 TEST-FLD PIC S9(14)V9(08).
+ PROCEDURE DIVISION.
+ MOVE FUNCTION INTEGER ( X )
+ TO TEST-FLD.
+ IF TEST-FLD NOT = -2
+ DISPLAY 'INTEGER ( X ) wrong: ' TEST-FLD
+ END-DISPLAY
+ END-IF.
+ MOVE FUNCTION INTEGER ( Y / 71 )
+ TO TEST-FLD.
+ IF TEST-FLD NOT = 8462696833
+ DISPLAY 'INTEGER ( Y / 71 ) wrong: ' TEST-FLD
+ END-DISPLAY
+ END-IF.
+ STOP RUN.
+])
+
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION INTEGER-OF-DATE])
+AT_KEYWORDS([functions])
+
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 TEST-FLD PIC S9(09)V9(02).
+ PROCEDURE DIVISION.
+ MOVE FUNCTION INTEGER-OF-DATE ( 20000925 )
+ TO TEST-FLD.
+ IF TEST-FLD NOT = 000146000
+ DISPLAY TEST-FLD
+ END-DISPLAY
+ END-IF.
+ STOP RUN.
+])
+
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION INTEGER-OF-DAY])
+AT_KEYWORDS([functions])
+
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 TEST-FLD PIC S9(09)V9(02).
+ PROCEDURE DIVISION.
+ MOVE FUNCTION INTEGER-OF-DAY ( 2000269 )
+ TO TEST-FLD.
+ IF TEST-FLD NOT = 000146000
+ DISPLAY TEST-FLD
+ END-DISPLAY
+ END-IF.
+ STOP RUN.
+])
+
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION INTEGER-OF-FORMATTED-DATE])
+AT_KEYWORDS([functions])
+
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 day-int PIC 9(9).
+
+ PROCEDURE DIVISION.
+ *> The date 2013-12-30 is used as it can also be used to
+ *> check the conversion of dates in week form.
+ MOVE FUNCTION INTEGER-OF-FORMATTED-DATE
+ ("YYYY-MM-DD", "2013-12-30")
+ TO day-int
+ IF day-int <> 150844
+ DISPLAY "Test 1 failed: " day-int END-DISPLAY
+ END-IF
+
+ MOVE FUNCTION INTEGER-OF-FORMATTED-DATE
+ ("YYYY-DDD", "2013-364")
+ TO day-int
+ IF day-int <> 150844
+ DISPLAY "Test 2 failed: " day-int END-DISPLAY
+ END-IF
+
+ MOVE FUNCTION INTEGER-OF-FORMATTED-DATE
+ ("YYYY-Www-D", "2014-W01-1")
+ TO day-int
+ IF day-int <> 150844
+ DISPLAY "Test 3 failed: " day-int END-DISPLAY
+ END-IF
+
+ MOVE FUNCTION INTEGER-OF-FORMATTED-DATE
+ ("YYYY-MM-DDThh:mm:ss", "2013-12-30T12:34:56")
+ TO day-int
+ IF day-int <> 150844
+ DISPLAY "Test 4 failed: " day-int END-DISPLAY
+ END-IF
+
+ STOP RUN.
+])
+
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION INTEGER-PART])
+AT_KEYWORDS([functions])
+
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 X PIC S9(4)V9(4) VALUE -1.5.
+ 01 TEST-FLD PIC S9(04)V9(02).
+ PROCEDURE DIVISION.
+ MOVE FUNCTION INTEGER-PART ( X )
+ TO TEST-FLD.
+ IF TEST-FLD NOT = -1
+ DISPLAY TEST-FLD
+ END-DISPLAY
+ END-IF.
+ STOP RUN.
+])
+
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION LENGTH])
+AT_KEYWORDS([functions])
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 X PIC S9(4)V9(4) VALUE -1.5.
+ 01 TEST-FLD PIC S9(04)V9(02).
+ PROCEDURE DIVISION.
+ MOVE FUNCTION LENGTH ( X ) TO TEST-FLD
+ IF TEST-FLD NOT = 8
+ DISPLAY 'LENGTH "00128" wrong: ' TEST-FLD
+ END-DISPLAY
+ END-IF
+
+ MOVE FUNCTION LENGTH ( '00128' )
+ TO TEST-FLD
+ IF TEST-FLD NOT = 5
+ DISPLAY 'LENGTH "00128" wrong: ' TEST-FLD
+ END-DISPLAY
+ END-IF
+
+ MOVE FUNCTION LENGTH ( x'a0' )
+ TO TEST-FLD
+ IF TEST-FLD NOT = 1
+ DISPLAY 'LENGTH x"a0" wrong: ' TEST-FLD
+ END-DISPLAY
+ END-IF
+
+ MOVE FUNCTION LENGTH ( z'a0' )
+ TO TEST-FLD
+ IF TEST-FLD NOT = 3
+ DISPLAY 'LENGTH z"a0" wrong: ' TEST-FLD
+ END-DISPLAY
+ END-IF
+
+ STOP RUN.
+])
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION LOCALE-COMPARE])
+AT_KEYWORDS([functions])
+
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ PROCEDURE DIVISION.
+ IF FUNCTION LOCALE-COMPARE ("A", "B") NOT = "<"
+ DISPLAY "Test 1 fail"
+ END-DISPLAY
+ END-IF.
+ IF FUNCTION LOCALE-COMPARE ("B", "A") NOT = ">"
+ DISPLAY "Test 2 fail"
+ END-DISPLAY
+ END-IF.
+ IF FUNCTION LOCALE-COMPARE ("A", "A") NOT = "="
+ DISPLAY "Test 3 fail"
+ END-DISPLAY
+ END-IF.
+ STOP RUN.
+])
+
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION LOCALE-DATE])
+AT_KEYWORDS([functions])
+
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 X PIC X(32) VALUE SPACES.
+ PROCEDURE DIVISION.
+ MOVE FUNCTION LOCALE-DATE ( "19630302" ) TO X.
+ IF X NOT = SPACES
+ DISPLAY "OK"
+ END-DISPLAY
+ END-IF.
+ STOP RUN.
+])
+
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0],
+[OK
+])
+
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION LOCALE-TIME])
+AT_KEYWORDS([functions])
+
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 X PIC X(32) VALUE SPACES.
+ PROCEDURE DIVISION.
+ MOVE FUNCTION LOCALE-TIME ( "233012" ) TO X.
+ IF X NOT = SPACES
+ DISPLAY "OK"
+ END-DISPLAY
+ END-IF.
+ STOP RUN.
+])
+
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0],
+[OK
+])
+
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION LOCALE-TIME-FROM-SECONDS])
+AT_KEYWORDS([functions])
+
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 X PIC X(32) VALUE SPACES.
+ PROCEDURE DIVISION.
+ MOVE FUNCTION LOCALE-TIME-FROM-SECONDS ( 33012 ) TO X.
+ IF X NOT = SPACES
+ DISPLAY "OK"
+ END-DISPLAY
+ END-IF.
+ STOP RUN.
+])
+
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0],
+[OK
+])
+
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION LOG])
+AT_KEYWORDS([functions])
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 Y PIC S9V9(33).
+ PROCEDURE DIVISION.
+ MOVE FUNCTION LOG ( 1.5 ) TO Y.
+ IF Y NOT = 0.405465108108164381978013115464349
+ DISPLAY Y
+ END-DISPLAY
+ END-IF.
+ STOP RUN.
+])
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION LOG10])
+AT_KEYWORDS([functions])
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 Y PIC S9V9(33).
+ PROCEDURE DIVISION.
+ MOVE FUNCTION LOG10 ( 1.5 ) TO Y.
+ IF Y NOT = 0.176091259055681242081289008530622
+ DISPLAY Y
+ END-DISPLAY
+ END-IF.
+ STOP RUN.
+])
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION LOWER-CASE])
+AT_KEYWORDS([functions])
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 X PIC X(10) VALUE "A#B.C%D+E$".
+ 01 TEST-FLD PIC X(12) VALUE ALL '_'.
+ PROCEDURE DIVISION.
+ STRING FUNCTION LOWER-CASE ( X )
+ DELIMITED BY SIZE
+ INTO TEST-FLD
+ END-STRING
+ IF TEST-FLD NOT = 'a#b.c%d+e$__'
+ DISPLAY TEST-FLD
+ END-DISPLAY
+ END-IF.
+ STOP RUN.
+])
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION LOWER-CASE with reference modding])
+AT_KEYWORDS([functions])
+
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 X PIC X(10) VALUE "A#B.C%D+E$".
+ 01 TEST-FLD PIC X(03).
+ PROCEDURE DIVISION.
+ MOVE FUNCTION LOWER-CASE ( X ) (1 : 3)
+ TO TEST-FLD
+ IF TEST-FLD NOT = 'a#b'
+ DISPLAY TEST-FLD
+ END-DISPLAY
+ END-IF.
+ STOP RUN.
+])
+
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION LOWEST-ALGEBRAIC])
+AT_KEYWORDS([functions])
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 F1 PIC S999.
+ 01 F2 PIC S9(4) BINARY.
+ 01 F3 PIC 99V9(3).
+ 01 F4 PIC $**,**9.99BCR.
+ 01 F5 PIC $**,**9.99.
+ 01 F6 USAGE BINARY-CHAR SIGNED.
+ 01 F7 USAGE BINARY-CHAR UNSIGNED.
+ 01 F8 PIC S999PPP.
+ 01 F9 PIC SP99.
+ PROCEDURE DIVISION.
+ IF FUNCTION LOWEST-ALGEBRAIC (F1) NOT = -999
+ DISPLAY "Test 1 fail"
+ END-DISPLAY
+ END-IF.
+ IF FUNCTION LOWEST-ALGEBRAIC (F2) NOT = -9999
+ DISPLAY "Test 2 fail"
+ END-DISPLAY
+ END-IF.
+ IF FUNCTION LOWEST-ALGEBRAIC (F3) NOT = 0
+ DISPLAY "Test 3 fail"
+ END-DISPLAY
+ END-IF.
+ IF FUNCTION LOWEST-ALGEBRAIC (F4) NOT = -99999.99
+ DISPLAY "Test 4 fail"
+ END-DISPLAY
+ END-IF.
+ IF FUNCTION LOWEST-ALGEBRAIC (F5) NOT = 0
+ DISPLAY "Test 5 fail"
+ END-DISPLAY
+ END-IF.
+ IF FUNCTION LOWEST-ALGEBRAIC (F6) NOT = -128
+ DISPLAY "Test 6 fail"
+ END-DISPLAY
+ END-IF.
+ IF FUNCTION LOWEST-ALGEBRAIC (F7) NOT = 0
+ DISPLAY "Test 7 fail"
+ END-DISPLAY
+ END-IF.
+ IF FUNCTION LOWEST-ALGEBRAIC (F8) NOT = -999000
+ DISPLAY "Test 8 fail"
+ END-DISPLAY
+ END-IF.
+ IF FUNCTION LOWEST-ALGEBRAIC (F9) NOT = -0.099
+ DISPLAY "Test 9 fail"
+ END-DISPLAY
+ END-IF.
+
+ STOP RUN.
+])
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION MAX])
+AT_KEYWORDS([functions])
+
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ PROCEDURE DIVISION.
+ DISPLAY FUNCTION MAX ( 3 -14 0 8 -3 )
+ END-DISPLAY.
+ STOP RUN.
+])
+
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0],
+[8
+], [])
+
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION MEAN])
+AT_KEYWORDS([functions])
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 result PIC S999V999.
+ PROCEDURE DIVISION.
+ COMPUTE result = FUNCTION MEAN ( 3 -14 0 8 -3 )
+ DISPLAY result
+ END-DISPLAY.
+ STOP RUN.
+])
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0],
+[-001.200
+])
+
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION MEDIAN])
+AT_KEYWORDS([functions])
+
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ PROCEDURE DIVISION.
+ DISPLAY FUNCTION MEDIAN ( 3 -14 0 8 -3 )
+ END-DISPLAY.
+ STOP RUN.
+])
+
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0],
+[0
+])
+
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION MIDRANGE])
+AT_KEYWORDS([functions])
+
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 RESULT PIC S999V999.
+ PROCEDURE DIVISION.
+ COMPUTE RESULT = FUNCTION MIDRANGE ( 3 -14 0 8 -3 )
+ DISPLAY RESULT
+ END-DISPLAY.
+ STOP RUN.
+])
+
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0],
+[-003.000
+])
+
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION MIN])
+AT_KEYWORDS([functions])
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ PROCEDURE DIVISION.
+ DISPLAY FUNCTION MIN ( 3 -14 0 8 -3 )
+ END-DISPLAY.
+ STOP RUN.
+])
+
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0],
+[-14
+])
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION MOD (valid)])
+AT_KEYWORDS([functions])
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 Y PIC 9(12) VALUE 600851475143.
+ 01 R PIC S9(4)V9(4) VALUE 0.
+ PROCEDURE DIVISION.
+ MOVE FUNCTION MOD ( -11 5 ) TO R
+ IF R NOT = 4
+ DISPLAY 'first one wrong: ' R
+ END-DISPLAY
+ END-IF
+ MOVE FUNCTION MOD ( Y, 71 ) TO R
+ IF R NOT = 0
+ DISPLAY 'second one wrong: ' R
+ END-DISPLAY
+ END-IF
+ STOP RUN.
+])
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION MOD (invalid)])
+AT_KEYWORDS([functions exceptions])
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 Z PIC 9 VALUE 0.
+ 01 R PIC S9(4)V9(4) VALUE 1.
+ PROCEDURE DIVISION.
+ MOVE FUNCTION MOD ( -11 Z ) TO R
+ IF FUNCTION EXCEPTION-STATUS
+ NOT = 'EC-ARGUMENT-FUNCTION'
+ DISPLAY 'Wrong/missing exception: '
+ FUNCTION EXCEPTION-STATUS
+ END-DISPLAY
+ END-IF
+ IF R NOT = 0
+ DISPLAY 'result is not zero: ' R
+ END-DISPLAY
+ END-IF
+ STOP RUN.
+])
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+AT_CLEANUP
+
+
+
+
+AT_SETUP([FUNCTION NUMVAL])
+AT_KEYWORDS([functions])
+
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 X1 PIC X(12) VALUE " -9876.1234 ".
+ 01 X2 PIC X(18) VALUE " 19876.1234 CR".
+ 01 N PIC s9(5)v9(5).
+ PROCEDURE DIVISION.
+ MOVE FUNCTION NUMVAL ( X1 ) TO N
+ IF N NOT = -9876.1234
+ DISPLAY N
+ END-DISPLAY
+ END-IF
+ MOVE FUNCTION NUMVAL ( X2 ) TO N
+ IF N NOT = -19876.1234
+ DISPLAY N
+ END-DISPLAY
+ END-IF
+ STOP RUN.
+])
+
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION NUMVAL-C])
+AT_KEYWORDS([functions])
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 X1 PIC X(14) VALUE " -% 9876.1234 ".
+ 01 X2 PIC X(20) VALUE " % 19,876.1234 DB".
+ 01 N PIC s9(5)v9(5).
+ PROCEDURE DIVISION.
+ MOVE FUNCTION NUMVAL-C ( X1 , "%" ) TO N
+ IF N NOT = -9876.1234
+ DISPLAY N
+ END-DISPLAY
+ END-IF
+ MOVE FUNCTION NUMVAL-C ( X2 , "%" ) TO N
+ IF N NOT = -19876.1234
+ DISPLAY N
+ END-DISPLAY
+ END-IF
+ STOP RUN.
+])
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION NUMVAL-C DP.COMMA])
+AT_KEYWORDS([functions])
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ ENVIRONMENT DIVISION.
+ CONFIGURATION SECTION.
+ SPECIAL-NAMES.
+ DECIMAL-POINT IS COMMA
+ .
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 X1 PIC X(20) VALUE " % 19.876,1234 DB".
+ 01 N PIC s9(5)v9(5).
+ PROCEDURE DIVISION.
+ MOVE FUNCTION NUMVAL-C ( X1 , "%" ) TO N
+ IF N NOT = -19876,1234
+ DISPLAY N
+ END-DISPLAY
+ END-IF
+ STOP RUN.
+])
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION NUMVAL-F])
+AT_KEYWORDS([functions])
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 result PIC S9(8)V9(9) COMP-5.
+ 01 vector.
+ 05 vd.
+ 10 FILLER PIC X(32) VALUE " - 123.456 E + 2 ".
+ 10 FILLER PIC X(32) VALUE "123".
+ 10 FILLER PIC X(32) VALUE ".456".
+ 10 FILLER PIC X(32) VALUE "123.456".
+ 10 FILLER PIC X(32) VALUE "-123.456".
+ 10 FILLER PIC X(32) VALUE "123.456E2".
+ 10 FILLER PIC X(32) VALUE "-123.456E-2".
+ 10 FILLER PIC X(32) VALUE "DONE".
+ 10 FILLER PIC X(32) OCCURS 100 TIMES.
+ 05 datat REDEFINES vd PIC X(32) OCCURS 100 TIMES INDEXED BY I.
+ PROCEDURE DIVISION.
+ SET I TO 1
+ PERFORM UNTIL datat(I) EQUALS "DONE"
+ DISPLAY """"datat(I)"""" SPACE WITH NO ADVANCING
+ MOVE FUNCTION NUMVAL-F(datat(I)) TO result
+ DISPLAY result
+ ADD 1 TO I
+ END-PERFORM.
+ STOP RUN.
+])
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0],
+[" - 123.456 E + 2 " -00012345.600000000
+"123 " +00000123.000000000
+".456 " +00000000.456000000
+"123.456 " +00000123.456000000
+"-123.456 " -00000123.456000000
+"123.456E2 " +00012345.600000000
+"-123.456E-2 " -00000001.234560000
+])
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION ORD])
+AT_KEYWORDS([functions])
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 RESULT PIC 999.
+ PROCEDURE DIVISION.
+ MOVE FUNCTION ORD ( "k" ) TO RESULT
+ DISPLAY RESULT
+ END-DISPLAY.
+ STOP RUN.
+])
+
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0],
+[108
+])
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION ORD-MAX])
+AT_KEYWORDS([functions])
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 RESULT PIC 999.
+ PROCEDURE DIVISION.
+ MOVE FUNCTION ORD-MAX ( 3 -14 0 8 -3 ) TO RESULT
+ DISPLAY RESULT
+ END-DISPLAY.
+ STOP RUN.
+])
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0],
+[004
+])
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION ORD-MIN])
+AT_KEYWORDS([functions])
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 RESULT PIC 999.
+ PROCEDURE DIVISION.
+ MOVE FUNCTION ORD-MIN ( 3 -14 0 8 -3 ) TO RESULT
+ DISPLAY RESULT
+ END-DISPLAY.
+ STOP RUN.
+])
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0],
+[002
+])
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION PI])
+AT_KEYWORDS([functions])
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 Y PIC 9V9(32).
+ PROCEDURE DIVISION.
+ MOVE FUNCTION PI TO Y.
+ IF Y NOT = 3.14159265358979323846264338327950
+ DISPLAY Y
+ END-DISPLAY
+ END-IF.
+ STOP RUN.
+])
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION PRESENT-VALUE])
+AT_KEYWORDS([functions])
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 RESULT PIC 9(5)V9(4).
+ PROCEDURE DIVISION.
+ MOVE FUNCTION PRESENT-VALUE ( 3 2 1 ) TO RESULT
+ DISPLAY RESULT
+ END-DISPLAY.
+ STOP RUN.
+])
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0],
+[00000.5625
+])
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION RANDOM])
+AT_KEYWORDS([functions])
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 Y PIC S99V99 COMP VALUE -1.0.
+ PROCEDURE DIVISION.
+ MOVE FUNCTION RANDOM ( ) TO Y.
+ IF Y < 0
+ DISPLAY Y
+ END-DISPLAY
+ END-IF.
+ STOP RUN.
+])
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION RANGE])
+AT_KEYWORDS([functions])
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 Z PIC S9(4)V9(4) COMP-5.
+ PROCEDURE DIVISION.
+ MOVE FUNCTION RANGE ( 3 -14 0 8 -3 ) TO Z.
+ IF Z NOT = 22
+ DISPLAY Z
+ END-DISPLAY
+ END-IF.
+ STOP RUN.
+])
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION REM (valid)])
+AT_KEYWORDS([functions])
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 R PIC S9(4)V9(4) COMP-5 VALUE 0.
+ PROCEDURE DIVISION.
+ MOVE FUNCTION REM ( -11 5 ) TO R
+ IF R NOT = -1
+ DISPLAY R END-DISPLAY
+ END-IF
+ STOP RUN.
+])
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION REM (invalid)])
+AT_KEYWORDS([functions exceptions])
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 R PIC S9(4)V9(4) COMP-5 VALUE 4.1.
+ 01 Z PIC 9 COMP-5 VALUE 0.
+ PROCEDURE DIVISION.
+ MOVE FUNCTION REM ( -11 Z ) TO R
+ IF FUNCTION EXCEPTION-STATUS
+ NOT = 'EC-ARGUMENT-FUNCTION'
+ DISPLAY 'Wrong/missing exception: '
+ FUNCTION EXCEPTION-STATUS
+ END-DISPLAY
+ END-IF
+ IF R NOT = 0
+ DISPLAY 'result is not zero: ' R
+ END-DISPLAY
+ END-IF
+ STOP RUN.
+])
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION REVERSE])
+AT_KEYWORDS([functions])
+
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 X PIC X(10) VALUE "A#B.C%D+E$".
+ 01 Z PIC X(10).
+ PROCEDURE DIVISION.
+ MOVE FUNCTION REVERSE ( X ) TO Z.
+ IF Z NOT = "$E+D%C.B#A"
+ DISPLAY Z
+ END-DISPLAY
+ END-IF.
+ STOP RUN.
+])
+
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION REVERSE with reference modding])
+AT_KEYWORDS([functions])
+
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 X PIC X(10) VALUE "A#B.C%D+E$".
+ 01 Z PIC X(10).
+ PROCEDURE DIVISION.
+ MOVE FUNCTION REVERSE ( X ) (1 : 4) TO Z.
+ IF Z NOT = "$E+D "
+ DISPLAY Z
+ END-DISPLAY
+ END-IF.
+ STOP RUN.
+])
+
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION SECONDS-FROM-FORMATTED-TIME])
+AT_KEYWORDS([functions])
+
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 result PIC 9(8)V9(9) COMP-5.
+ PROCEDURE DIVISION.
+ MOVE FUNCTION SECONDS-FROM-FORMATTED-TIME
+ ("hhmmss", "010203")
+ TO result.
+ IF result NOT = 3723
+ DISPLAY "Test 1 failed: " result
+ END-DISPLAY
+ END-IF.
+
+ MOVE FUNCTION SECONDS-FROM-FORMATTED-TIME
+ ("hh:mm:ss", "01:02:03")
+ TO result.
+ IF result NOT = 3723
+ DISPLAY "Test 2 failed: " result
+ END-DISPLAY
+ END-IF.
+
+ MOVE FUNCTION SECONDS-FROM-FORMATTED-TIME
+ ("hhmmss.ssssssss", "010203.04050607")
+ TO result.
+ IF result NOT = 3723.04050607
+ DISPLAY "Test 3 failed: " result
+ END-DISPLAY
+ END-IF.
+
+ MOVE FUNCTION SECONDS-FROM-FORMATTED-TIME
+ ("hhmmssZ", "010203Z")
+ TO result.
+ IF result NOT = 3723
+ DISPLAY "Test 4 failed: " result
+ END-DISPLAY
+ END-IF.
+
+ MOVE FUNCTION SECONDS-FROM-FORMATTED-TIME
+ ("hhmmss+hhmm", "010203+0405")
+ TO result.
+ IF result NOT = 3723
+ DISPLAY "Test 5 failed: " result
+ END-DISPLAY
+ END-IF.
+
+ MOVE FUNCTION SECONDS-FROM-FORMATTED-TIME
+ ("YYYYMMDDThhmmss", "16010101T010203")
+ TO result.
+ IF result NOT = 3723
+ DISPLAY "Test 6 failed: " result
+ END-DISPLAY
+ END-IF.
+
+ STOP RUN.
+])
+
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION SECONDS-PAST-MIDNIGHT])
+AT_KEYWORDS([functions])
+
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 Y PIC 9(8) COMP-5.
+ PROCEDURE DIVISION.
+ MOVE FUNCTION SECONDS-PAST-MIDNIGHT TO Y.
+ IF Y NOT < 86402
+ DISPLAY Y
+ END-DISPLAY
+ END-IF.
+ STOP RUN.
+])
+
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION SIGN])
+AT_KEYWORDS([functions])
+
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 Z USAGE BINARY-LONG SIGNED.
+ PROCEDURE DIVISION.
+ MOVE FUNCTION SIGN ( 3.12345 ) TO Z.
+ IF Z NOT = 1
+ DISPLAY "Sign 1 " Z
+ END-DISPLAY
+ END-IF.
+ MOVE FUNCTION SIGN ( -0.0 ) TO Z.
+ IF Z NOT = 0
+ DISPLAY "Sign 2 " Z
+ END-DISPLAY
+ END-IF.
+ MOVE FUNCTION SIGN ( 0.0 ) TO Z.
+ IF Z NOT = 0
+ DISPLAY "Sign 3 " Z
+ END-DISPLAY
+ END-IF.
+ MOVE FUNCTION SIGN ( -3.12345 ) TO Z.
+ IF Z NOT = -1
+ DISPLAY "Sign 4 " Z
+ END-DISPLAY
+ END-IF.
+ STOP RUN.
+])
+
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION SIN])
+AT_KEYWORDS([functions])
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 Y PIC S9V9(33).
+ PROCEDURE DIVISION.
+ MOVE FUNCTION SIN ( 1.5 ) TO Y.
+ IF Y NOT = 0.997494986604054430941723371141487
+ DISPLAY Y
+ END-DISPLAY
+ END-IF.
+ STOP RUN.
+])
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION SQRT])
+AT_KEYWORDS([functions])
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 Y PIC S9V9(33).
+ PROCEDURE DIVISION.
+ MOVE FUNCTION SQRT ( 1.5 ) TO Y.
+ IF Y NOT = 1.224744871391589049098642037352945
+ DISPLAY Y
+ END-DISPLAY
+ END-IF.
+ STOP RUN.
+])
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION STANDARD-DEVIATION])
+AT_KEYWORDS([functions])
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 Y PIC S9V9(32).
+ PROCEDURE DIVISION.
+ MOVE FUNCTION STANDARD-DEVIATION ( 3 -14 0 8 -3 ) TO Y.
+ IF Y NOT = 7.35934779718963954877237043574538
+ DISPLAY Y
+ END-DISPLAY
+ END-IF.
+ STOP RUN.
+])
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION SUBSTITUTE])
+AT_KEYWORDS([functions])
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 Y PIC X(24).
+ PROCEDURE DIVISION.
+ MOVE "abc111444555defxxabc" TO Y
+ DISPLAY FUNCTION TRIM (FUNCTION SUBSTITUTE ( Y "abc" "zz" "55" "666" ))
+
+ MOVE "bobBobjimJimbobBobjimJim" TO Y
+ DISPLAY FUNCTION SUBSTITUTE ( Y "bob" "FILLER" "jim" "Z")
+
+ MOVE "bobBobjimJimbobBobjimJim" TO Y
+ DISPLAY FUNCTION SUBSTITUTE ( Y FIRST "bob" "FILLER" "jim" "Z")
+
+ MOVE "bobBobjimJimbobBobjimJim" TO Y
+ DISPLAY FUNCTION SUBSTITUTE ( Y LAST "bob" "FILLER" "jim" "Z")
+
+ MOVE "bobBobjimJimbobBobjimJim" TO Y
+ DISPLAY FUNCTION SUBSTITUTE ( Y ANYCASE "bob" "FILLER" ANYCASE "jim" "Z")
+])
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0],
+[zz1114446665defxxzz
+FILLERBobZJimFILLERBobZJim
+FILLERBobZJimbobBobZJim
+bobBobZJimFILLERBobZJim
+FILLERFILLERZZFILLERFILLERZZ
+], [])
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION SUBSTITUTE with reference modding])
+AT_KEYWORDS([functions])
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 Y PIC X(20).
+ 01 Z PIC X(20).
+ PROCEDURE DIVISION.
+ MOVE "abc111444555defxxabc" TO Y.
+ MOVE FUNCTION SUBSTITUTE
+ ( Y "abc" "zz" "55" "666" ) (2 : 9)
+ TO Z.
+ IF Z NOT = "z11144466"
+ DISPLAY Z
+ END-DISPLAY
+ END-IF.
+ STOP RUN.
+])
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION SUBSTITUTE-CASE])
+AT_KEYWORDS([functions])
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 Y PIC X(20).
+ 01 Z PIC X(20).
+ PROCEDURE DIVISION.
+ MOVE "ABC111444555defxxabc" TO Y.
+ MOVE FUNCTION SUBSTITUTE (Y anycase "abc" "zz"
+ anycase "55" "666")
+ TO Z.
+ IF Z NOT = "zz1114446665defxxzz"
+ DISPLAY Z
+ END-DISPLAY
+ END-IF.
+ STOP RUN.
+])
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION SUBSTITUTE-CASE with reference mod])
+AT_KEYWORDS([functions])
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 Y PIC X(20).
+ 01 Z PIC X(20).
+ PROCEDURE DIVISION.
+ MOVE "abc111444555defxxabc" TO Y.
+ MOVE FUNCTION SUBSTITUTE
+ ( Y anycase "ABC" "zz"
+ anycase "55" "666" ) (2 : 9)
+ TO Z.
+ IF Z NOT = "z11144466"
+ DISPLAY Z
+ END-DISPLAY
+ END-IF.
+ STOP RUN.
+])
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION SUM])
+AT_KEYWORDS([functions])
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 Z USAGE BINARY-LONG.
+ PROCEDURE DIVISION.
+ MOVE FUNCTION SUM ( 3 -14 0 8 -3 ) TO Z.
+ IF Z NOT = -6
+ DISPLAY Z
+ END-DISPLAY
+ END-IF.
+ STOP RUN.
+])
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION TAN])
+AT_KEYWORDS([functions])
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 Y PIC S99V9(31).
+ PROCEDURE DIVISION.
+ MOVE FUNCTION TAN ( 1.5 ) TO Y.
+ IF Y NOT = 14.1014199471717193876460836519877
+ DISPLAY Y
+ END-DISPLAY
+ END-IF.
+ STOP RUN.
+])
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION TEST-DATE-YYYYMMDD])
+AT_KEYWORDS([functions])
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 RESULT PIC 999.
+ PROCEDURE DIVISION.
+ MOVE FUNCTION TEST-DATE-YYYYMMDD ( 20020231 ) TO RESULT
+ DISPLAY RESULT
+ END-DISPLAY.
+ STOP RUN.
+])
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0],
+[003
+])
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION TEST-DAY-YYYYDDD])
+AT_KEYWORDS([functions])
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 RESULT PIC 999.
+ PROCEDURE DIVISION.
+ MOVE FUNCTION TEST-DAY-YYYYDDD ( 2002400 ) TO RESULT
+ DISPLAY RESULT
+ END-DISPLAY.
+ STOP RUN.
+])
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0],
+[002
+])
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION TEST-FORMATTED-DATETIME with dates])
+AT_KEYWORDS([functions])
+
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ PROCEDURE DIVISION.
+ IF FUNCTION TEST-FORMATTED-DATETIME
+ ("YYYYMMDD", "16010101") <> 0
+ DISPLAY "Test 1 failed" END-DISPLAY
+ END-IF
+ IF FUNCTION TEST-FORMATTED-DATETIME
+ ("YYYY-MM-DD", "1601-01-01") <> 0
+ DISPLAY "Test 2 failed" END-DISPLAY
+ END-IF
+ IF FUNCTION TEST-FORMATTED-DATETIME
+ ("YYYYDDD", "1601001") <> 0
+ DISPLAY "Test 3 failed" END-DISPLAY
+ END-IF
+ IF FUNCTION TEST-FORMATTED-DATETIME
+ ("YYYY-DDD", "1601-001") <> 0
+ DISPLAY "Test 4 failed" END-DISPLAY
+ END-IF
+ IF FUNCTION TEST-FORMATTED-DATETIME
+ ("YYYYWwwD", "1601W011") <> 0
+ DISPLAY "Test 5 failed" END-DISPLAY
+ END-IF
+ IF FUNCTION TEST-FORMATTED-DATETIME
+ ("YYYY-Www-D", "1601-W01-1") <> 0
+ DISPLAY "Test 6 failed" END-DISPLAY
+ END-IF
+
+
+ *> How will this work with zero-length items?
+ IF FUNCTION TEST-FORMATTED-DATETIME
+ ("YYYYMMDD", "1") <> 2
+ DISPLAY "Test 7 failed" END-DISPLAY
+ END-IF
+ IF FUNCTION TEST-FORMATTED-DATETIME
+ ("YYYYMMDD", "160A0101") <> 4
+ DISPLAY "Test 8 failed" END-DISPLAY
+ END-IF
+ IF FUNCTION TEST-FORMATTED-DATETIME
+ ("YYYYMMDD", "00000101") <> 1
+ DISPLAY "Test 9 failed" END-DISPLAY
+ END-IF
+ IF FUNCTION TEST-FORMATTED-DATETIME
+ ("YYYYMMDD", "16000101") <> 4
+ DISPLAY "Test 10 failed" END-DISPLAY
+ END-IF
+ IF FUNCTION TEST-FORMATTED-DATETIME
+ ("YYYYMMDD", "16010001") <> 6
+ DISPLAY "Test 11 failed" END-DISPLAY
+ END-IF
+ IF FUNCTION TEST-FORMATTED-DATETIME
+ ("YYYYMMDD", "16011301") <> 6
+ DISPLAY "Test 12 failed" END-DISPLAY
+ END-IF
+ IF FUNCTION TEST-FORMATTED-DATETIME
+ ("YYYYMMDD", "16010190") <> 7
+ DISPLAY "Test 13 failed" END-DISPLAY
+ END-IF
+ IF FUNCTION TEST-FORMATTED-DATETIME
+ ("YYYYMMDD", "18000229") <> 8
+ DISPLAY "Test 14 failed" END-DISPLAY
+ END-IF
+ IF FUNCTION TEST-FORMATTED-DATETIME
+ ("YYYY-MM-DD", "1601 01 01") <> 5
+ DISPLAY "Test 15 failed" END-DISPLAY
+ END-IF
+ IF FUNCTION TEST-FORMATTED-DATETIME
+ ("YYYYMMDD", "160101010") <> 9
+ DISPLAY "Test 16 failed" END-DISPLAY
+ END-IF
+ IF FUNCTION TEST-FORMATTED-DATETIME
+ ("YYYYWwwD", "1601A011") <> 5
+ DISPLAY "Test 17 failed" END-DISPLAY
+ END-IF
+ IF FUNCTION TEST-FORMATTED-DATETIME
+ ("YYYYWwwD", "1601W531") <> 7
+ DISPLAY "Test 18 failed" END-DISPLAY
+ END-IF
+ IF FUNCTION TEST-FORMATTED-DATETIME
+ ("YYYYWwwD", "1601W601") <> 6
+ DISPLAY "Test 19 failed" END-DISPLAY
+ END-IF
+ IF FUNCTION TEST-FORMATTED-DATETIME
+ ("YYYYWwwD", "2009W531") <> 0
+ DISPLAY "Test 20 failed" END-DISPLAY
+ END-IF
+ IF FUNCTION TEST-FORMATTED-DATETIME
+ ("YYYYWwwD", "1601W018") <> 8
+ DISPLAY "Test 21 failed" END-DISPLAY
+ END-IF
+ IF FUNCTION TEST-FORMATTED-DATETIME
+ ("YYYYDDD", "1601366") <> 7
+ DISPLAY "Test 22 failed" END-DISPLAY
+ END-IF
+ IF FUNCTION TEST-FORMATTED-DATETIME
+ ("YYYYDDD", "1601370") <> 6
+ DISPLAY "Test 23 failed" END-DISPLAY
+ END-IF
+ IF FUNCTION TEST-FORMATTED-DATETIME
+ ("YYYYDDD", "1601400") <> 5
+ DISPLAY "Test 24 failed" END-DISPLAY
+ END-IF
+ IF FUNCTION TEST-FORMATTED-DATETIME
+ ("YYYYMMDD", "01") <> 1
+ DISPLAY "Test 25 failed" END-DISPLAY
+ END-IF
+ IF FUNCTION TEST-FORMATTED-DATETIME
+ ("YYYYMMDD", "1601010") <> 8
+ DISPLAY "Test 26 failed" END-DISPLAY
+ END-IF
+
+ STOP RUN
+ .
+])
+
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION TEST-FORMATTED-DATETIME with times])
+AT_KEYWORDS([functions])
+
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ PROCEDURE DIVISION.
+ IF FUNCTION TEST-FORMATTED-DATETIME
+ ("hhmmss.sssssssssZ", "000000.000000000Z") <> 0
+ DISPLAY "Test 1 failed" END-DISPLAY
+ END-IF
+ IF FUNCTION TEST-FORMATTED-DATETIME
+ ("hh:mm:ss.sssssssssZ", "00:00:00.000000000Z") <> 0
+ DISPLAY "Test 2 failed" END-DISPLAY
+ END-IF
+ *> 0 instead of +/- valid in sending fields with offset of zero.
+ IF FUNCTION TEST-FORMATTED-DATETIME
+ ("hhmmss.sssssssss+hhmm", "000000.00000000000000")
+ <> 0
+ DISPLAY "Test 3 failed" END-DISPLAY
+ END-IF
+ IF FUNCTION TEST-FORMATTED-DATETIME
+ ("hh:mm:ss.sssssssss+hh:mm",
+ "00:00:00.000000000+00:00")
+ <> 0
+ DISPLAY "Test 4 failed" END-DISPLAY
+ END-IF
+
+ IF FUNCTION TEST-FORMATTED-DATETIME
+ ("hhmmss", "300000") <> 1
+ DISPLAY "Test 5 failed" END-DISPLAY
+ END-IF
+ IF FUNCTION TEST-FORMATTED-DATETIME
+ ("hhmmss", "250000") <> 2
+ DISPLAY "Test 6 failed" END-DISPLAY
+ END-IF
+ IF FUNCTION TEST-FORMATTED-DATETIME
+ ("hhmmss", "006000") <> 3
+ DISPLAY "Test 7 failed" END-DISPLAY
+ END-IF
+ IF FUNCTION TEST-FORMATTED-DATETIME
+ ("hhmmss", "000060") <> 5
+ DISPLAY "Test 8 failed" END-DISPLAY
+ END-IF
+ IF FUNCTION TEST-FORMATTED-DATETIME
+ ("hh:mm:ss", "00-00-00") <> 3
+ DISPLAY "Test 9 failed" END-DISPLAY
+ END-IF
+ IF FUNCTION TEST-FORMATTED-DATETIME
+ ("hhmmss.ss", "000000,00") <> 7
+ DISPLAY "Test 10 failed" END-DISPLAY
+ END-IF
+ IF FUNCTION TEST-FORMATTED-DATETIME
+ ("hhmmss+hhmm", "000000 0000") <> 7
+ DISPLAY "Test 11 failed" END-DISPLAY
+ END-IF
+ IF FUNCTION TEST-FORMATTED-DATETIME
+ ("hhmmss+hhmm", "00000000001") <> 11
+ DISPLAY "Test 12 failed" END-DISPLAY
+ END-IF
+ IF FUNCTION TEST-FORMATTED-DATETIME
+ ("hhmmssZ", "000000A") <> 7
+ DISPLAY "Test 13 failed" END-DISPLAY
+ END-IF
+ IF FUNCTION TEST-FORMATTED-DATETIME
+ ("hhmmss", SPACE) <> 1
+ DISPLAY "Test 14 failed" END-DISPLAY
+ END-IF
+
+ STOP RUN
+ .
+])
+
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION TEST-FORMATTED-DATETIME with datetimes])
+AT_KEYWORDS([functions])
+
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 77 RESULT PIC 9(02).
+ PROCEDURE DIVISION.
+ MOVE FUNCTION TEST-FORMATTED-DATETIME
+ ("YYYYMMDDThhmmss", "16010101T000000")
+ TO RESULT
+ IF RESULT <> 0
+ DISPLAY "Test 1 failed: " RESULT END-DISPLAY
+ END-IF
+ MOVE FUNCTION TEST-FORMATTED-DATETIME
+ ("YYYY-MM-DDThh:mm:ss.sssssssss+hh:mm",
+ "1601-01-01T00:00:00.000000000+00:00")
+ TO RESULT
+ IF RESULT <> 0
+ DISPLAY "Test 2 failed: " RESULT END-DISPLAY
+ END-IF
+
+ MOVE FUNCTION TEST-FORMATTED-DATETIME
+ ("YYYYMMDDThhmmss", "16010101 000000")
+ TO RESULT
+ IF RESULT <> 9
+ DISPLAY "Test 3 failed: " RESULT END-DISPLAY
+ END-IF
+ MOVE FUNCTION TEST-FORMATTED-DATETIME
+ ("YYYYMMDDThhmmss", SPACE)
+ TO RESULT
+ IF RESULT <> 1
+ DISPLAY "Test 4 failed: " RESULT END-DISPLAY
+ END-IF
+ MOVE FUNCTION TEST-FORMATTED-DATETIME
+ ("YYYYMMDDThhmmss", "16010101T ")
+ TO RESULT
+ IF RESULT <> 10
+ DISPLAY "Test 5 failed: " RESULT END-DISPLAY
+ END-IF
+
+ STOP RUN
+ .
+])
+
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION TEST-FORMATTED-DATETIME DP.COMMA])
+AT_KEYWORDS([functions])
+
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ ENVIRONMENT DIVISION.
+ CONFIGURATION SECTION.
+ SPECIAL-NAMES.
+ DECIMAL-POINT IS COMMA.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ PROCEDURE DIVISION.
+ IF FUNCTION TEST-FORMATTED-DATETIME
+ ("hhmmss,ss", "000000,00") <> 0
+ DISPLAY "Test 1 failed" END-DISPLAY
+ END-IF
+ IF FUNCTION TEST-FORMATTED-DATETIME
+ ("YYYYMMDDThhmmss,ss", "16010101T000000,00") <> 0
+ DISPLAY "Test 2 failed" END-DISPLAY
+ END-IF
+
+ IF FUNCTION TEST-FORMATTED-DATETIME
+ ("hhmmss,ss", "000000.00") <> 7
+ DISPLAY "Test 3 failed" END-DISPLAY
+ END-IF
+ IF FUNCTION TEST-FORMATTED-DATETIME
+ ("YYYYMMDDThhmmss,ss", "16010101T000000.00") <> 16
+ DISPLAY "Test 4 failed" END-DISPLAY
+ END-IF
+
+ STOP RUN
+ .
+])
+
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION TEST-NUMVAL])
+AT_KEYWORDS([functions])
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ PROCEDURE DIVISION.
+ IF FUNCTION TEST-NUMVAL ("+ 1") NOT = 0
+ DISPLAY "Test 1 fail"
+ END-DISPLAY
+ END-IF.
+ IF FUNCTION TEST-NUMVAL (" + 1") NOT = 0
+ DISPLAY "Test 2 fail"
+ END-DISPLAY
+ END-IF.
+ IF FUNCTION TEST-NUMVAL ("- 1") NOT = 0
+ DISPLAY "Test 3 fail"
+ END-DISPLAY
+ END-IF.
+ IF FUNCTION TEST-NUMVAL (" - 1") NOT = 0
+ DISPLAY "Test 4 fail"
+ END-DISPLAY
+ END-IF.
+ IF FUNCTION TEST-NUMVAL ("+- 1") NOT = 2
+ DISPLAY "Test 5 fail"
+ END-DISPLAY
+ END-IF.
+ IF FUNCTION TEST-NUMVAL ("1 +") NOT = 0
+ DISPLAY "Test 6 fail"
+ END-DISPLAY
+ END-IF.
+ IF FUNCTION TEST-NUMVAL ("1 -") NOT = 0
+ DISPLAY "Test 7 fail"
+ END-DISPLAY
+ END-IF.
+ IF FUNCTION TEST-NUMVAL ("1 +-") NOT = 4
+ DISPLAY "Test 8 fail"
+ END-DISPLAY
+ END-IF.
+ IF FUNCTION TEST-NUMVAL ("1 -+") NOT = 4
+ DISPLAY "Test 9 fail"
+ END-DISPLAY
+ END-IF.
+ IF FUNCTION TEST-NUMVAL ("+ 1.1") NOT = 0
+ DISPLAY "Test 10 fail"
+ END-DISPLAY
+ END-IF.
+ IF FUNCTION TEST-NUMVAL ("- 1.1") NOT = 0
+ DISPLAY "Test 11 fail"
+ END-DISPLAY
+ END-IF.
+ IF FUNCTION TEST-NUMVAL ("1.1 +") NOT = 0
+ DISPLAY "Test 12 fail"
+ END-DISPLAY
+ END-IF.
+ IF FUNCTION TEST-NUMVAL ("1.1 -") NOT = 0
+ DISPLAY "Test 13 fail"
+ END-DISPLAY
+ END-IF.
+ IF FUNCTION TEST-NUMVAL ("1.1 CR") NOT = 0
+ DISPLAY "Test 14 fail"
+ END-DISPLAY
+ END-IF.
+ IF FUNCTION TEST-NUMVAL ("1.1 DB") NOT = 0
+ DISPLAY "Test 15 fail"
+ END-DISPLAY
+ END-IF.
+ IF FUNCTION TEST-NUMVAL ("1.1 -CR") NOT = 6
+ DISPLAY "Test 16 fail"
+ END-DISPLAY
+ END-IF.
+ IF FUNCTION TEST-NUMVAL ("1.1 +DB") NOT = 6
+ DISPLAY "Test 17 fail"
+ END-DISPLAY
+ END-IF.
+ IF FUNCTION TEST-NUMVAL ("1.1 CDB") NOT = 6
+ DISPLAY "Test 18 fail"
+ END-DISPLAY
+ END-IF.
+ IF FUNCTION TEST-NUMVAL ("+1.1 CR") NOT = 6
+ DISPLAY "Test 19 fail"
+ END-DISPLAY
+ END-IF.
+ IF FUNCTION TEST-NUMVAL ("+ ") NOT = 8
+ DISPLAY "Test 20 fail"
+ END-DISPLAY
+ END-IF.
+ STOP RUN.
+])
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION TEST-NUMVAL-C])
+AT_KEYWORDS([functions])
+
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ PROCEDURE DIVISION.
+ IF FUNCTION TEST-NUMVAL-C ("+ 1") NOT = 0
+ DISPLAY "Test 1 fail"
+ END-DISPLAY
+ END-IF.
+ IF FUNCTION TEST-NUMVAL-C (" + 1") NOT = 0
+ DISPLAY "Test 2 fail"
+ END-DISPLAY
+ END-IF.
+ IF FUNCTION TEST-NUMVAL-C ("- 1") NOT = 0
+ DISPLAY "Test 3 fail"
+ END-DISPLAY
+ END-IF.
+ IF FUNCTION TEST-NUMVAL-C (" - 1") NOT = 0
+ DISPLAY "Test 4 fail"
+ END-DISPLAY
+ END-IF.
+ IF FUNCTION TEST-NUMVAL-C ("+- 1") NOT = 2
+ DISPLAY "Test 5 fail"
+ END-DISPLAY
+ END-IF.
+ IF FUNCTION TEST-NUMVAL-C ("1 +") NOT = 0
+ DISPLAY "Test 6 fail"
+ END-DISPLAY
+ END-IF.
+ IF FUNCTION TEST-NUMVAL-C ("1 -") NOT = 0
+ DISPLAY "Test 7 fail"
+ END-DISPLAY
+ END-IF.
+ IF FUNCTION TEST-NUMVAL-C ("1 +-") NOT = 4
+ DISPLAY "Test 8 fail"
+ END-DISPLAY
+ END-IF.
+ IF FUNCTION TEST-NUMVAL-C ("1 -+") NOT = 4
+ DISPLAY "Test 9 fail"
+ END-DISPLAY
+ END-IF.
+ IF FUNCTION TEST-NUMVAL-C ("+ 1.1") NOT = 0
+ DISPLAY "Test 10 fail"
+ END-DISPLAY
+ END-IF.
+ IF FUNCTION TEST-NUMVAL-C ("- 1.1") NOT = 0
+ DISPLAY "Test 11 fail"
+ END-DISPLAY
+ END-IF.
+ IF FUNCTION TEST-NUMVAL-C ("1.1 +") NOT = 0
+ DISPLAY "Test 12 fail"
+ END-DISPLAY
+ END-IF.
+ IF FUNCTION TEST-NUMVAL-C ("1.1 -") NOT = 0
+ DISPLAY "Test 13 fail"
+ END-DISPLAY
+ END-IF.
+ IF FUNCTION TEST-NUMVAL-C ("1.1 CR") NOT = 0
+ DISPLAY "Test 14 fail"
+ END-DISPLAY
+ END-IF.
+ IF FUNCTION TEST-NUMVAL-C ("1.1 DB") NOT = 0
+ DISPLAY "Test 15 fail"
+ END-DISPLAY
+ END-IF.
+ IF FUNCTION TEST-NUMVAL-C ("1.1 -CR") NOT = 6
+ DISPLAY "Test 16 fail"
+ END-DISPLAY
+ END-IF.
+ IF FUNCTION TEST-NUMVAL-C ("+ $1.1 ") NOT = 0
+ DISPLAY "Test 17 fail"
+ END-DISPLAY
+ END-IF.
+ IF FUNCTION TEST-NUMVAL-C ("- $1.1 ") NOT = 0
+ DISPLAY "Test 18 fail"
+ END-DISPLAY
+ END-IF.
+ IF FUNCTION TEST-NUMVAL-C ("+ X1.1 ", "X") NOT = 0
+ DISPLAY "Test 19 fail"
+ END-DISPLAY
+ END-IF.
+ IF FUNCTION TEST-NUMVAL-C ("- X1.1 ", "X") NOT = 0
+ DISPLAY "Test 20 fail"
+ END-DISPLAY
+ END-IF.
+ STOP RUN.
+])
+
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+AT_CLEANUP
+
+AT_SETUP([FUNCTION TEST-NUMVAL-F])
+AT_KEYWORDS([functions])
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ PROCEDURE DIVISION.
+ IF FUNCTION TEST-NUMVAL-F ("+ 1") NOT = 0
+ DISPLAY "Test 1 fail"
+ END-DISPLAY
+ END-IF.
+ IF FUNCTION TEST-NUMVAL-F (" + 1") NOT = 0
+ DISPLAY "Test 2 fail"
+ END-DISPLAY
+ END-IF.
+ IF FUNCTION TEST-NUMVAL-F ("- 1") NOT = 0
+ DISPLAY "Test 3 fail"
+ END-DISPLAY
+ END-IF.
+ IF FUNCTION TEST-NUMVAL-F (" - 1") NOT = 0
+ DISPLAY "Test 4 fail"
+ END-DISPLAY
+ END-IF.
+ IF FUNCTION TEST-NUMVAL-F ("+- 1") NOT = 2
+ DISPLAY "Test 5 fail"
+ END-DISPLAY
+ END-IF.
+ IF FUNCTION TEST-NUMVAL-F ("1 +") NOT = 3
+ DISPLAY "Test 6 fail"
+ END-DISPLAY
+ END-IF.
+ IF FUNCTION TEST-NUMVAL-F ("1 -") NOT = 3
+ DISPLAY "Test 7 fail"
+ END-DISPLAY
+ END-IF.
+ IF FUNCTION TEST-NUMVAL-F ("1 +-") NOT = 3
+ DISPLAY "Test 8 fail"
+ END-DISPLAY
+ END-IF.
+ IF FUNCTION TEST-NUMVAL-F ("1 -+") NOT = 3
+ DISPLAY "Test 9 fail"
+ END-DISPLAY
+ END-IF.
+ IF FUNCTION TEST-NUMVAL-F ("+ 1.1") NOT = 0
+ DISPLAY "Test 10 fail"
+ END-DISPLAY
+ END-IF.
+ IF FUNCTION TEST-NUMVAL-F ("- 1.1") NOT = 0
+ DISPLAY "Test 11 fail"
+ END-DISPLAY
+ END-IF.
+ IF FUNCTION TEST-NUMVAL-F ("1.1 +") NOT = 5
+ DISPLAY "Test 12 fail"
+ END-DISPLAY
+ END-IF.
+ IF FUNCTION TEST-NUMVAL-F ("1.1 -") NOT = 5
+ DISPLAY "Test 13 fail"
+ END-DISPLAY
+ END-IF.
+ IF FUNCTION TEST-NUMVAL-F ("1.1 ") NOT = 0
+ DISPLAY "Test 14 fail"
+ END-DISPLAY
+ END-IF.
+ IF FUNCTION TEST-NUMVAL-F ("1.1 ") NOT = 0
+ DISPLAY "Test 15 fail"
+ END-DISPLAY
+ END-IF.
+ IF FUNCTION TEST-NUMVAL-F ("1.1 -CR") NOT = 5
+ DISPLAY "Test 16 fail"
+ END-DISPLAY
+ END-IF.
+ IF FUNCTION TEST-NUMVAL-F ("1.1 E+1") NOT = 0
+ DISPLAY "Test 17 fail"
+ END-DISPLAY
+ END-IF.
+ IF FUNCTION TEST-NUMVAL-F ("1.1 E -1") NOT = 0
+ DISPLAY "Test 18 fail"
+ END-DISPLAY
+ END-IF.
+ IF FUNCTION TEST-NUMVAL-F ("1.1 EE") NOT = 6
+ DISPLAY "Test 19 fail"
+ END-DISPLAY
+ END-IF.
+ IF FUNCTION TEST-NUMVAL-F ("+1.1 E+01") NOT = 0
+ DISPLAY "Test 20 fail"
+ END-DISPLAY
+ END-IF.
+ STOP RUN.
+])
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION TRIM])
+AT_KEYWORDS([functions])
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 X PIC X(12) VALUE " a#b.c%d+e$ ".
+ PROCEDURE DIVISION.
+ DISPLAY FUNCTION TRIM ( X )
+ END-DISPLAY.
+ DISPLAY FUNCTION TRIM ( X TRAILING )
+ END-DISPLAY.
+ STOP RUN.
+])
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0],
+[a#b.c%d+e$
+ a#b.c%d+e$
+])
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION TRIM with reference modding])
+AT_KEYWORDS([functions])
+
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 X PIC X(12) VALUE " a#b.c%d+e$ ".
+ PROCEDURE DIVISION.
+ DISPLAY FUNCTION TRIM ( X ) (2 : 3)
+ END-DISPLAY.
+ DISPLAY FUNCTION TRIM ( X TRAILING ) (2 : 3)
+ END-DISPLAY.
+ STOP RUN.
+])
+
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0],
+[#b.
+a#b
+])
+
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION TRIM zero length])
+AT_KEYWORDS([functions])
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 A2 PIC X(2) VALUE " ".
+ 01 A3 PIC X(3) VALUE " ".
+ 01 X PIC X(4) VALUE "NOOK".
+ PROCEDURE DIVISION.
+ MOVE FUNCTION TRIM ( A2 ) TO X.
+ DISPLAY ">" X "<"
+ END-DISPLAY.
+ DISPLAY ">" FUNCTION TRIM ( A3 ) "<"
+ END-DISPLAY.
+ STOP RUN.
+])
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0],
+[> <
+><
+])
+
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION UPPER-CASE])
+AT_KEYWORDS([functions])
+
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 X PIC X(10) VALUE "a#b.c%d+e$".
+ 01 Z PIC X(10).
+ PROCEDURE DIVISION.
+ MOVE FUNCTION UPPER-CASE ( X ) TO Z.
+ IF Z NOT = "A#B.C%D+E$"
+ DISPLAY Z
+ END-DISPLAY
+ END-IF.
+ STOP RUN.
+])
+
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION UPPER-CASE with reference modding])
+AT_KEYWORDS([functions])
+
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 X PIC X(10) VALUE "a#b.c%d+e$".
+ 01 Z PIC X(4).
+ PROCEDURE DIVISION.
+ MOVE FUNCTION UPPER-CASE ( X ) (1 : 3) TO Z.
+ IF Z NOT = "A#B "
+ DISPLAY Z
+ END-DISPLAY
+ END-IF.
+ STOP RUN.
+])
+
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION VARIANCE])
+AT_KEYWORDS([functions])
+
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 Z PIC S9(4)V9(4) COMP-5.
+ PROCEDURE DIVISION.
+ MOVE FUNCTION VARIANCE ( 3 -14 0 8 -3 ) TO Z.
+ IF Z NOT = 54.16
+ DISPLAY Z
+ END-DISPLAY
+ END-IF.
+ STOP RUN.
+])
+
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+
+AT_CLEANUP
+
+
+AT_SETUP([FUNCTION WHEN-COMPILED])
+AT_KEYWORDS([functions])
+
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 compiled-datetime.
+ 03 compiled-date.
+ 05 millennium PIC X.
+ 05 FILLER PIC X(15).
+ 03 timezone PIC X(5).
+ PROCEDURE DIVISION.
+ *> Check millennium.
+ MOVE FUNCTION WHEN-COMPILED TO compiled-datetime.
+ IF millennium NOT = "2"
+ DISPLAY "Millennium NOT OK: " millennium
+ END-DISPLAY
+ END-IF.
+
+ *> Check timezone.
+ IF timezone NOT = FUNCTION CURRENT-DATE (17:5)
+ DISPLAY "Timezone NOT OK: " timezone
+ END-DISPLAY
+ END-IF.
+
+ *> Check date format.
+ INSPECT compiled-date CONVERTING "0123456789"
+ TO "9999999999".
+ IF compiled-date NOT = ALL "9"
+ DISPLAY "Date format NOT OK: " compiled-date
+ END-DISPLAY
+ END-IF.
+
+ *> Check timezone format.
+ IF timezone NOT = "00000"
+ INSPECT timezone CONVERTING "0123456789"
+ TO "9999999999"
+ IF timezone NOT = "+9999" AND "-9999"
+ DISPLAY "Timezone format NOT OK: " timezone
+ END-DISPLAY
+ END-IF
+ END-IF.
+
+ STOP RUN.
+])
+
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+AT_CLEANUP
+
+AT_SETUP([FUNCTION YEAR-TO-YYYY])
+AT_KEYWORDS([functions])
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 Z USAGE BINARY-LONG.
+ PROCEDURE DIVISION.
+ MOVE FUNCTION YEAR-TO-YYYY ( 50 ) TO Z.
+ IF Z NOT = 2050
+ DISPLAY Z
+ END-DISPLAY
+ END-IF.
+ STOP RUN.
+])
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+AT_CLEANUP
+
+AT_SETUP([UDF RETURNING group and PIC 9(5)])
+AT_KEYWORDS([functions])
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ FUNCTION-ID. COPYPAR.
+ DATA DIVISION.
+ LINKAGE SECTION.
+ 01 PARSA.
+ 02 PAR1 PICTURE X(32).
+ 02 PAR2 PICTURE X(32).
+ 01 PARSB.
+ 02 PAR1 PICTURE X(32).
+ 02 PAR2 PICTURE X(32).
+ PROCEDURE DIVISION USING PARSA RETURNING PARSB.
+ MOVE PARSA TO PARSB
+ DISPLAY """" PARSB """"
+ GOBACK.
+ END FUNCTION COPYPAR.
+ IDENTIFICATION DIVISION.
+ FUNCTION-ID. COPYPAR2.
+ DATA DIVISION.
+ LINKAGE SECTION.
+ 01 PARSB PIC 99999.
+ 01 PAR5 PIC 99999.
+ PROCEDURE DIVISION USING PAR5 RETURNING PARSB.
+ MOVE PAR5 TO PARSB
+ DISPLAY PARSB
+ GOBACK.
+ END FUNCTION COPYPAR2.
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ ENVIRONMENT DIVISION.
+ CONFIGURATION SECTION.
+ REPOSITORY.
+ FUNCTION COPYPAR.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 PARS1.
+ 02 PAR1 PICTURE X(32) VALUE "Santa".
+ 02 PAR2 PICTURE X(32) VALUE "Claus".
+ 01 PARS2.
+ 02 PAR1 PICTURE X(32).
+ 02 PAR2 PICTURE X(32).
+ 01 PAR5 PICTURE 99999 VALUE 54321.
+ PROCEDURE DIVISION.
+ MOVE COPYPAR(PARS1) TO PARS2
+ DISPLAY """" PARS2 """".
+ DISPLAY COPYPAR2(PAR5)
+ STOP RUN.
+ END PROGRAM prog.
+])
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], ["Santa Claus "
+"Santa Claus "
+54321
+54321
+], [])
+AT_CLEANUP
+
diff --git a/gcc/cobol/failures/copypar/Makefile b/gcc/cobol/failures/copypar/Makefile
deleted file mode 100644
index f77e46b3451abf45cb70ed9dc161be56b3b063c7..0000000000000000000000000000000000000000
--- a/gcc/cobol/failures/copypar/Makefile
+++ /dev/null
@@ -1 +0,0 @@
-include ../Makefile.inc
diff --git a/gcc/cobol/failures/copypar/input.txt b/gcc/cobol/failures/copypar/input.txt
deleted file mode 100644
index e69de29bb2d1d6434b8b29ae775ad8c2e48c5391..0000000000000000000000000000000000000000
diff --git a/gcc/cobol/failures/copypar/playpen.cbl b/gcc/cobol/failures/copypar/playpen.cbl
deleted file mode 100644
index 0740403183dbf47344a48c46aee4d16cbfd5b57b..0000000000000000000000000000000000000000
--- a/gcc/cobol/failures/copypar/playpen.cbl
+++ /dev/null
@@ -1,36 +0,0 @@
- IDENTIFICATION DIVISION.
- FUNCTION-ID. COPYPAR.
- DATA DIVISION.
- LINKAGE SECTION.
- 01 PARSA.
- 02 PAR1 PICTURE X(32).
- 02 PAR2 PICTURE X(32).
- 01 PARSB.
- 02 PAR1 PICTURE X(32).
- 02 PAR2 PICTURE X(32).
- PROCEDURE DIVISION USING PARSA RETURNING PARSB.
- MOVE PARSA TO PARSB
- DISPLAY PARSB
- GOBACK.
- END FUNCTION COPYPAR.
-
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- ENVIRONMENT DIVISION.
- CONFIGURATION SECTION.
- REPOSITORY.
- FUNCTION COPYPAR.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 PARS1.
- 02 PAR1 PICTURE X(32) VALUE "Santa".
- 02 PAR2 PICTURE X(32) VALUE "Claus".
- 01 PARS2.
- 02 PAR1 PICTURE X(32).
- 02 PAR2 PICTURE X(32).
- PROCEDURE DIVISION.
- MOVE COPYPAR(PARS1) TO PARS2
- DISPLAY PARS2.
-
- STOP RUN.
- END PROGRAM prog.
diff --git a/gcc/cobol/parse_ante.h b/gcc/cobol/parse_ante.h
index c798c928b308a6b21281561421c9506d4b1e5080..a1e8e9effe467b82734e26b55546e46ac4a0184e 100644
--- a/gcc/cobol/parse_ante.h
+++ b/gcc/cobol/parse_ante.h
@@ -1842,10 +1842,12 @@ static inline cbl_field_t *
new_temporary_clone( const cbl_field_t *orig) {
cbl_field_type_t type = is_literal(orig)? FldAlphanumeric : orig->type;
auto f = new_temporary_imply(type);
- f->data = orig->data;
- if( orig->type == FldGroup ) {
- namcpy(f->name, orig->name);
+// f->data = orig->data;
+// if( orig->type == FldGroup)
+ {
+ memcpy(f, orig, sizeof(cbl_field_t));
+// namcpy(f->name, orig->name);
f->attr = temporary_e;
f->var_decl_node = NULL;
f->data_decl_node = NULL;