cobol: New testcases.

author Bob Dubner <rdubner@symas.com>

Fri, 4 Apr 2025 18:41:27 +0000 (14:41 -0400)

committer Robert Dubner <rdubner@symas.com>

Fri, 4 Apr 2025 20:04:01 +0000 (16:04 -0400)
author Bob Dubner <rdubner@symas.com>
Fri, 4 Apr 2025 18:41:27 +0000 (14:41 -0400)
committer Robert Dubner <rdubner@symas.com>
Fri, 4 Apr 2025 20:04:01 +0000 (16:04 -0400)
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_ABS.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_ABS.cob

new file mode 100644 (file)

index 0000000..3f4049b
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_ABS.cob
@@ -0,0 +1,14 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/FUNCTION_ABS.out" }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_ABS.out b/gcc/testsuite/cobol.dg/group2/FUNCTION_ABS.out

new file mode 100644 (file)

index 0000000..ab39cfe
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_ABS.out
@@ -0,0 +1,2 @@
++0001.2345
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_ACOS.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_ACOS.cob

new file mode 100644 (file)

index 0000000..73e192f
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_ACOS.cob
@@ -0,0 +1,15 @@
+       *> { dg-do run }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_ALL_INTRINSIC_simple_test.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_ALL_INTRINSIC_simple_test.cob

new file mode 100644 (file)

index 0000000..276c33f
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_ALL_INTRINSIC_simple_test.cob
@@ -0,0 +1,17 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/FUNCTION_ALL_INTRINSIC_simple_test.out" }
+
+       IDENTIFICATION DIVISION.
+       PROGRAM-ID. phase0.
+       ENVIRONMENT DIVISION.
+       CONFIGURATION SECTION.
+       REPOSITORY.
+           FUNCTION ALL INTRINSIC.
+       DATA DIVISION.
+       WORKING-STORAGE SECTION.
+       77 work-string pic X(80) VALUE "      ABC      ".
+       PROCEDURE DIVISION.
+       DISPLAY """" TRIM(work-string) """"
+       goback.
+       end program phase0.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_ALL_INTRINSIC_simple_test.out b/gcc/testsuite/cobol.dg/group2/FUNCTION_ALL_INTRINSIC_simple_test.out

new file mode 100644 (file)

index 0000000..7b9bc93
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_ALL_INTRINSIC_simple_test.out
@@ -0,0 +1,2 @@
+"ABC"
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_ANNUITY.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_ANNUITY.cob

new file mode 100644 (file)

index 0000000..29049dd
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_ANNUITY.cob
@@ -0,0 +1,15 @@
+       *> { dg-do run }
+
+       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.002932551319648093841642228739003
+              DISPLAY Z
+              END-DISPLAY
+           END-IF.
+           STOP RUN.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_ASIN.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_ASIN.cob

new file mode 100644 (file)

index 0000000..b364a40
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_ASIN.cob
@@ -0,0 +1,15 @@
+       *> { dg-do run }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_ATAN.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_ATAN.cob

new file mode 100644 (file)

index 0000000..1f884ce
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_ATAN.cob
@@ -0,0 +1,15 @@
+       *> { dg-do run }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_BIGGER-POINTER.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_BIGGER-POINTER.cob

new file mode 100644 (file)

index 0000000..70b40ba
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_BIGGER-POINTER.cob
@@ -0,0 +1,40 @@
+       *> { dg-do run }
+       *> { dg-options "-dialect ibm" }
+       *> { dg-output-file "group2/FUNCTION_BIGGER-POINTER.out" }
+
+       IDENTIFICATION   DIVISION.
+       PROGRAM-ID.      prog.
+       DATA             DIVISION.
+       WORKING-STORAGE  SECTION.
+       01  N                PIC     S9(8) COMP-5 value 0.
+       01  P   REDEFINES N  POINTER.
+       01  FILLER.
+        05 X                PIC      A(4) VALUE "ABC".
+        05 E REDEFINES X    PIC      A(1)  OCCURS 4.
+       LINKAGE SECTION.
+       77  B                PIC      A.
+
+       PROCEDURE        DIVISION.
+           set P to address of E(1).
+
+           display FUNCTION trim(x) '.'
+
+           set address of B to p.
+           perform until B = SPACE
+             display B no advancing
+             set p up by 1
+             set address of B to p
+           end-perform
+           display '.'
+
+           set P to address of E(1)
+           set address of B to p
+           perform until B = SPACES
+             display B no advancing
+             add 1 to N
+             set address of B to p
+           end-perform
+           display '.'
+
+           STOP RUN.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_BIGGER-POINTER.out b/gcc/testsuite/cobol.dg/group2/FUNCTION_BIGGER-POINTER.out

new file mode 100644 (file)

index 0000000..d31e83b
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_BIGGER-POINTER.out
@@ -0,0 +1,4 @@
+ABC.
+ABC.
+ABC.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_BIGGER-POINTER__2_.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_BIGGER-POINTER__2_.cob

new file mode 100644 (file)

index 0000000..d6d04d1
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_BIGGER-POINTER__2_.cob
@@ -0,0 +1,22 @@
+       *> { dg-do run }
+       *> { dg-options "-dialect ibm" }
+       *> { dg-output-file "group2/FUNCTION_BIGGER-POINTER__2_.out" }
+
+        identification   division.
+        program-id.      prog.
+        data             division.
+        working-storage  section.
+        01  n4                 pic     s9(8) comp-5 value 0.
+        01  p4   redefines n4  pointer.
+        01  n8                 pic     s9(16) comp-5 value 0.
+        01  p8   redefines n8  pointer.
+        procedure        division.
+            move -1 to n8
+            set     p4 to p8
+            display "P4 and P8 before: " p4 space p8
+            display "Increment N4 and N8"
+            add 1 to n4 n8
+            display "P4 and P8  after: " p4 space p8
+            goback.
+            end program prog.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_BIGGER-POINTER__2_.out b/gcc/testsuite/cobol.dg/group2/FUNCTION_BIGGER-POINTER__2_.out

new file mode 100644 (file)

index 0000000..b15a754
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_BIGGER-POINTER__2_.out
@@ -0,0 +1,4 @@
+P4 and P8 before: 0xffffffffffffffff 0xffffffffffffffff
+Increment N4 and N8
+P4 and P8  after: 0x0000000000000000 0x0000000000000000
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_BYTE-LENGTH.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_BYTE-LENGTH.cob

new file mode 100644 (file)

index 0000000..9a5f384
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_BYTE-LENGTH.cob
@@ -0,0 +1,20 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/FUNCTION_BYTE-LENGTH.out" }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_BYTE-LENGTH.out b/gcc/testsuite/cobol.dg/group2/FUNCTION_BYTE-LENGTH.out

new file mode 100644 (file)

index 0000000..64ad515
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_BYTE-LENGTH.out
@@ -0,0 +1,5 @@
+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
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_CHAR.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_CHAR.cob

new file mode 100644 (file)

index 0000000..955cc51
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_CHAR.cob
@@ -0,0 +1,29 @@
+       *> { dg-do run }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_COMBINED-DATETIME.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_COMBINED-DATETIME.cob

new file mode 100644 (file)

index 0000000..3f9c6e1
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_COMBINED-DATETIME.cob
@@ -0,0 +1,16 @@
+       *> { dg-do run }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_CONCAT___CONCATENATE.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_CONCAT___CONCATENATE.cob

new file mode 100644 (file)

index 0000000..d982432
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_CONCAT___CONCATENATE.cob
@@ -0,0 +1,36 @@
+       *> { dg-do run }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_CONCAT_with_reference_modding.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_CONCAT_with_reference_modding.cob

new file mode 100644 (file)

index 0000000..98f21c3
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_CONCAT_with_reference_modding.cob
@@ -0,0 +1,19 @@
+       *> { dg-do run }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_COS.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_COS.cob

new file mode 100644 (file)

index 0000000..6651b9d
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_COS.cob
@@ -0,0 +1,15 @@
+       *> { dg-do run }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_CURRENT-DATE.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_CURRENT-DATE.cob

new file mode 100644 (file)

index 0000000..429f247
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_CURRENT-DATE.cob
@@ -0,0 +1,62 @@
+       *> { dg-do run }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_DATE-OF-INTEGER.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_DATE-OF-INTEGER.cob

new file mode 100644 (file)

index 0000000..708aa96
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_DATE-OF-INTEGER.cob
@@ -0,0 +1,16 @@
+       *> { dg-do run }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_DATE-TO-YYYYMMDD.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_DATE-TO-YYYYMMDD.cob

new file mode 100644 (file)

index 0000000..5b2bd43
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_DATE-TO-YYYYMMDD.cob
@@ -0,0 +1,16 @@
+       *> { dg-do run }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_DATE___TIME_OMNIBUS.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_DATE___TIME_OMNIBUS.cob

new file mode 100644 (file)

index 0000000..bb48bb0
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_DATE___TIME_OMNIBUS.cob
@@ -0,0 +1,334 @@
+       *> { dg-do run }
+
+        identification division.
+        program-id. test.
+      *>  Tests all the DATE and TIME functions
+      *>
+      *>  The various functions are used to test each other.
+      *>
+      *>  COMBINED-DATETIME             OK
+      *>  CURRENT_DATE                  OK
+      *>  DATE-OF-INTEGER               OK
+      *>  DATE-TO-YYYYMMDD              OK
+      *>  DAY-OF-INTEGER                OK
+      *>  DAY-TO-YYYYDDD                OK
+      *>  FORMATTED-CURRENT-DATE        OK
+      *>  FORMATTED-DATE                OK
+      *>  FORMATTED-DATETIME            OK
+      *>  FORMATTED-TIME                OK
+      *>  INTEGER-OF-DATE               OK
+      *>  INTEGER-OF-DAY                OK
+      *>  INTEGER-OF-FORMATTED-DATE     OK
+      *>  SECONDS-FROM-FORMATTED-TIME   OK
+      *>  SECONDS-PAST-MIDNIGHT         OK
+      *>  TEST-DATE-YYYYMMDD            OK
+      *>  TEST-DAY-YYYYDDD              OK
+      *>  TEST-FORMATTED-DATETIME       OK
+      *>
+        data division.
+        working-storage section.
+
+        01 checking  pic x(80).
+        01 should-be pic x(32).
+        01 but-is    pic x(32).
+        01 but-is-n redefines but-is pic 99999999.999999.
+        01 but-is-integer_part pic 99999.
+
+        01 jd1601 pic 9(7).
+        01 jd9999 pic 9(7).
+        01 jd     pic s9(7).
+
+        01 integer-date pic s9(7).
+        01 integer-result pic 99.
+        01 standard-date-form pic 9(8).
+        01 julian-date-form PIC 9(8).
+
+        01 date1.
+            02 YYYY pic 9999.
+            02 MM     pic 99.
+            02 DD     pic 99.
+        01 date2.
+            02 YYYY   pic 9999.
+            02 filler pic x value "-".
+            02 MM     pic 99.
+            02 filler pic x value "-".
+            02 DD     pic 99.
+        01 date3.
+            02 YYYY   pic 9999.
+            02 DDD    pic 999.
+        01 date4.
+            02 YYYY   pic 9999.
+            02 filler pic x value "-".
+            02 DDD     pic 999.
+        01 date5.
+            02 YYYY   pic 9999.
+            02 filler pic x value "W".
+            02 ww     pic 99.
+            02 d      pic 9.
+        01 date6.
+            02 YYYY   pic 9999.
+            02 filler pic xx value "-W".
+            02 ww     pic 99.
+            02 filler pic x value "-".
+            02 d      pic 9.
+
+        01 yymmdd.
+            02 YY pic 99.
+            02 MM pic 99.
+            02 DD pic 99.
+
+        01 minus10 pic s99 value -10.
+
+        01 forced_date_n pic X(64) VALUE Z"COB_CURRENT_DATE".
+        01 forced_date_v pic X(64) VALUE Z"1945/06/01 12:34:56".
+
+        procedure division.
+        CALL "setenv" using forced_date_n, forced_date_v
+
+        move "SECONDS-PAST-MIDNIGHT" to checking
+        move "45296" to should-be
+        MOVE FUNCTION SECONDS-PAST-MIDNIGHT to but-is-integer_part
+        move but-is-integer_part to but-is
+        perform checkit
+
+      *>    Establish the initial date integer
+        move "integer-of-date" to checking
+        move function integer-of-date(19000101) to jd1601
+        move "integer-of-date(19000101)" to checking
+        move 0109208 to should-be
+        move jd1601 to but-is
+        perform checkit
+
+      *>    Establish the final date integer
+        move "integer-of-date" to checking
+        move function integer-of-date(21011231) to jd9999
+        move "integer-of-date(21001231)" to checking
+        move 0182986 to should-be
+        move jd9999 to but-is
+        perform checkit
+
+      *>    We are going to do the following tests over all valid dates:
+        perform varying jd from jd1601 by 1 until jd > jd9999
+
+      *>    Convert JD to all six DATE types:
+            move FUNCTION FORMATTED-DATE("YYYYMMDD"   jd) TO date1
+            move FUNCTION FORMATTED-DATE("YYYY-MM-DD" jd) TO date2
+            move FUNCTION FORMATTED-DATE("YYYYDDD"    jd) TO date3
+            move FUNCTION FORMATTED-DATE("YYYY-DDD"   jd) TO date4
+            move FUNCTION FORMATTED-DATE("YYYYWwwD"   jd) TO date5
+            move FUNCTION FORMATTED-DATE("YYYY-Www-D" jd) TO date6
+
+      *>    Test the routines that check DATE types
+            move zero to should-be
+            move FUNCTION TEST-FORMATTED-DATETIME("YYYYMMDD"   date1) TO but-is
+              move "TEST-FORMATTED-DATETIME(""YYYYMMDD""   date1)" to checking
+              perform checkit
+            move FUNCTION TEST-FORMATTED-DATETIME("YYYY-MM-DD" date2) TO but-is
+              move "TEST-FORMATTED-DATETIME(""YYYY-MM-DD"" date2)" to checking
+              perform checkit
+            move FUNCTION TEST-FORMATTED-DATETIME("YYYYDDD"    date3) TO but-is
+              move "TEST-FORMATTED-DATETIME(""YYYYDDD""    date3)" to checking
+              perform checkit
+            move FUNCTION TEST-FORMATTED-DATETIME("YYYY-DDD"   date4) TO but-is
+              move "TEST-FORMATTED-DATETIME(""YYYY-DDD""   date4)" to checking
+              perform checkit
+            move FUNCTION TEST-FORMATTED-DATETIME("YYYYWwwD"   date5) TO but-is
+              move "TEST-FORMATTED-DATETIME(""YYYYWwwD""   date5)" to checking
+              perform checkit
+            move FUNCTION TEST-FORMATTED-DATETIME("YYYY-Www-D" date6) TO but-is
+              move "TEST-FORMATTED-DATETIME(""YYYY-Www-D"" date6)" to checking
+              perform checkit
+
+      *>    Test the routines that extract the integer date
+
+            move function INTEGER-OF-FORMATTED-DATE("YYYYMMDD"   date1) TO integer-date
+              move "INTEGER-OF-FORMATTED-DATE(""YYYYMMDD""   date1)" to checking
+              move jd to should-be
+              move integer-date to but-is
+              perform checkit
+
+            move function INTEGER-OF-FORMATTED-DATE("YYYY-MM-DD"   date2) TO integer-date
+              move "INTEGER-OF-FORMATTED-DATE(""YYYY-MM-DD""   date2)" to checking
+              move jd to should-be
+              move integer-date to but-is
+              perform checkit
+
+            move function INTEGER-OF-FORMATTED-DATE("YYYYDDD"   date3) TO integer-date
+              move "INTEGER-OF-FORMATTED-DATE(""YYYYDDD""   date3)" to checking
+              move jd to should-be
+              move integer-date to but-is
+              perform checkit
+
+            move function INTEGER-OF-FORMATTED-DATE("YYYY-DDD"   date4) TO integer-date
+              move "INTEGER-OF-FORMATTED-DATE(""YYYY-DDD""   date4)" to checking
+              move jd to should-be
+              move integer-date to but-is
+              perform checkit
+
+            move function INTEGER-OF-FORMATTED-DATE("YYYYWwwD"   date5) TO integer-date
+              move "INTEGER-OF-FORMATTED-DATE(""YYYYWwwD""   date5)" to checking
+              move jd to should-be
+              move integer-date to but-is
+              perform checkit
+
+            move function INTEGER-OF-FORMATTED-DATE("YYYY-Www-D"   date6) TO integer-date
+              move "INTEGER-OF-FORMATTED-DATE(""YYYY-Www-D""   date6)" to checking
+              move jd to should-be
+              move integer-date to but-is
+              perform checkit
+
+            move function DATE-OF-INTEGER(jd) to standard-date-form
+            move function INTEGER-OF-DATE(standard-date-form) to integer-date
+              move "DATE-OF-INTEGER and INTEGER-OF-DATE" to checking
+              move jd to should-be
+              move integer-date to but-is
+              perform checkit
+
+            move function TEST-DATE-YYYYMMDD(standard-date-form) to integer-result
+              move "TEST-DATE-YYYYMMDD" to checking
+              move zero to should-be
+              move integer-result to but-is
+              perform checkit
+
+            move function DAY-OF-INTEGER(jd) to julian-date-form
+            move function INTEGER-OF-DAY(julian-date-form) to integer-date
+              move "DAY-OF-INTEGER and INTEGER-OF-DAY" to checking
+              move jd to should-be
+              move integer-date to but-is
+              perform checkit
+
+            move function TEST-DAY-YYYYDDD(julian-date-form) to integer-result
+              move "TEST-DAY-YYYYDDD" to checking
+              move zero to should-be
+              move integer-result to but-is
+              perform checkit
+            end-perform.
+
+        move function integer-of-date(19980101) to jd1601
+        move function integer-of-date(19981231) to jd9999
+        perform varying jd from jd1601 by 1 until jd > jd9999
+            move FUNCTION FORMATTED-DATE("YYYYMMDD"   jd) TO date1
+            move FUNCTION FORMATTED-DATE("YYYYDDD"    jd) TO date3
+
+            move FUNCTION MOD( YYYY of date1 100) to yy of yymmdd
+            move MM of date1 to MM of yymmdd
+            move DD of date1 to DD of yymmdd
+
+            move FUNCTION DATE-TO-YYYYMMDD(yymmdd, minus10, 1994)
+                        to standard-date-form
+              move "DATE-TO-YYYYMMDD" to checking
+              move "18" to date1(1:2)
+              move date1 to should-be
+              move standard-date-form to but-is
+              perform checkit
+            end-perform.
+
+        move "DAY-TO-YYYYDDD" to checking
+        MOVE 1910004 to should-be
+        MOVE FUNCTION DAY-TO-YYYYDDD(10004 -20 2002) TO but-is
+        perform checkit
+        MOVE 1810004 to should-be
+        MOVE FUNCTION DAY-TO-YYYYDDD(10004 -120 2002) TO but-is
+        perform checkit
+        MOVE 2010004 to should-be
+        MOVE FUNCTION DAY-TO-YYYYDDD(10004 20 2002) TO but-is
+        perform checkit
+        MOVE 1995005 to should-be
+        MOVE FUNCTION DAY-TO-YYYYDDD(95005 -10 2013) TO but-is
+        perform checkit
+
+        move "COMBINED-DATETIME" to checking
+        MOVE "19450601.123456" TO should-be
+        MOVE FUNCTION COMBINED-DATETIME(19450601 123456) TO but-is-n
+        perform checkit
+
+        move "CURRENT_DATE" to checking
+        MOVE "1945060112345600+0000" TO should-be
+        MOVE FUNCTION CURRENT-DATE TO but-is
+        move "+0000" to but-is(17:5)
+        perform checkit
+
+        move "FORMATTED-CURRENT-DATE (1)" to checking
+        MOVE "1945-06-01T12:34:56" TO should-be
+        MOVE FUNCTION FORMATTED-CURRENT-DATE("YYYY-MM-DDThh:mm:ss") TO but-is
+        perform blot-zulu
+        perform checkit
+
+        move "FORMATTED-CURRENT-DATE (2)" to checking
+        MOVE "1945-06-01T12:34:56Z" TO should-be
+        MOVE FUNCTION FORMATTED-CURRENT-DATE("YYYY-MM-DDThh:mm:ssZ") TO but-is
+        perform blot-zulu
+        perform checkit
+
+        move "FORMATTED-CURRENT-DATE (3)" to checking
+        MOVE "1945-06-01T12:34:56-05:00" TO should-be
+        MOVE FUNCTION FORMATTED-CURRENT-DATE("YYYY-MM-DDThh:mm:ss+hh:mm") TO but-is
+        perform blot-zulu
+        perform checkit
+
+        move "formatted-time" to checking
+        move "01:12:34Z" to should-be
+        MOVE FUNCTION formatted-time("hh:mm:ssZ" 754 -60 ) to but-is
+        perform checkit.
+
+        move "00:12:34Z" to should-be
+        MOVE FUNCTION formatted-time("hh:mm:ssZ" 754   0 ) to but-is
+        perform checkit.
+
+        move "23:12:34Z" to should-be
+        MOVE FUNCTION formatted-time("hh:mm:ssZ" 754  60 ) to but-is
+        perform checkit.
+
+        move "formatted-datetime" to checking
+        MOVE "1900-01-01T00:00:00-01:00" TO SHOULD-BE
+        MOVE FUNCTION formatted-datetime("YYYY-MM-DDThh:mm:ss+hh:mm" 0109208 0 -60 ) TO but-is
+        perform checkit.
+
+        MOVE "1900-01-01T00:00:00+00:00" TO SHOULD-BE
+        MOVE FUNCTION formatted-datetime("YYYY-MM-DDThh:mm:ss+hh:mm" 0109208 0 -0 )  TO but-is
+        perform checkit.
+
+        MOVE "1900-01-01T00:00:00+01:00" TO SHOULD-BE
+        MOVE FUNCTION formatted-datetime("YYYY-MM-DDThh:mm:ss+hh:mm" 0109208 0 +60 ) TO but-is
+        perform checkit.
+
+        move "SECONDS-FROM-FORMATTED-TIME" to checking
+        MOVE "00043200.000000" TO SHOULD-BE
+        MOVE SPACE TO but-is
+        MOVE FUNCTION SECONDS-FROM-FORMATTED-TIME("hh:mm:ss" "12:00:00") TO but-is-n
+        perform checkit.
+
+        stop run.
+
+        checkit.
+      *>      display "checkit " """" should-be """" space """" but-is """"
+            if FUNCTION TRIM(should-be) IS NUMERIC AND FUNCTION TRIM(but-is) IS NUMERIC
+                if FUNCTION NUMVAL(should-be)
+                        not equal to FUNCTION NUMVAL(but-is)
+                    and should-be not equal to but-is
+                    then
+                    display function trim (checking) ":"
+                            " should be " """" function trim (should-be) """"
+                            " but is "    """" function trim (but-is) """"
+                    move 1 to return-code
+                    end-if
+            else
+                if should-be not equal to but-is
+                    and should-be not equal to but-is
+                    then
+                    display function trim (checking) ":"
+                            " should be " """" function trim (should-be) """"
+                            " but is "    """" function trim (but-is) """"
+                    move 1 to return-code
+                end-if
+        .
+        blot-zulu.
+            move "hh:mm" TO but-is(12:5)
+            move "hh:mm" TO should-be(12:5)
+            if but-is(21:1) not equal to space
+                move "+hh:mm" TO but-is(20:6)
+                move "+hh:mm" TO should-be(20:6)
+                end-if
+        .
+        end program test.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_DAY-OF-INTEGER.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_DAY-OF-INTEGER.cob

new file mode 100644 (file)

index 0000000..df70a82
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_DAY-OF-INTEGER.cob
@@ -0,0 +1,16 @@
+       *> { dg-do run }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_DAY-TO-YYYYDDD.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_DAY-TO-YYYYDDD.cob

new file mode 100644 (file)

index 0000000..5316a70
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_DAY-TO-YYYYDDD.cob
@@ -0,0 +1,16 @@
+       *> { dg-do run }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_E.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_E.cob

new file mode 100644 (file)

index 0000000..e07edf0
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_E.cob
@@ -0,0 +1,15 @@
+       *> { dg-do run }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_EXCEPTION-FILE.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_EXCEPTION-FILE.cob

new file mode 100644 (file)

index 0000000..e822708
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_EXCEPTION-FILE.cob
@@ -0,0 +1,26 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/FUNCTION_EXCEPTION-FILE.out" }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_EXCEPTION-FILE.out b/gcc/testsuite/cobol.dg/group2/FUNCTION_EXCEPTION-FILE.out

new file mode 100644 (file)

index 0000000..ece5467
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_EXCEPTION-FILE.out
@@ -0,0 +1 @@
+00|35TEST-FILE
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_EXCEPTION-STATEMENT.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_EXCEPTION-STATEMENT.cob

new file mode 100644 (file)

index 0000000..d68261d
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_EXCEPTION-STATEMENT.cob
@@ -0,0 +1,24 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/FUNCTION_EXCEPTION-STATEMENT.out" }
+
+        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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_EXCEPTION-STATEMENT.out b/gcc/testsuite/cobol.dg/group2/FUNCTION_EXCEPTION-STATEMENT.out

new file mode 100644 (file)

index 0000000..5656102
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_EXCEPTION-STATEMENT.out
@@ -0,0 +1,3 @@
+EXCEPTION-STATEMENT before bad OPEN: " "
+EXCEPTION-STATEMENT  after bad OPEN: "OPEN"
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_EXCEPTION-STATUS.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_EXCEPTION-STATUS.cob

new file mode 100644 (file)

index 0000000..1ffa366
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_EXCEPTION-STATUS.cob
@@ -0,0 +1,24 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/FUNCTION_EXCEPTION-STATUS.out" }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_EXCEPTION-STATUS.out b/gcc/testsuite/cobol.dg/group2/FUNCTION_EXCEPTION-STATUS.out

new file mode 100644 (file)

index 0000000..02b4f84
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_EXCEPTION-STATUS.out
@@ -0,0 +1,3 @@
+EXCEPTION STATUS before bad open: " "
+EXCEPTION STATUS  after bad open: "EC-I-O-PERMANENT-ERROR"
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_EXP.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_EXP.cob

new file mode 100644 (file)

index 0000000..756612c
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_EXP.cob
@@ -0,0 +1,15 @@
+       *> { dg-do run }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_EXP10.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_EXP10.cob

new file mode 100644 (file)

index 0000000..a76fcfb
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_EXP10.cob
@@ -0,0 +1,16 @@
+       *> { dg-do run }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_FACTORIAL.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_FACTORIAL.cob

new file mode 100644 (file)

index 0000000..969663c
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_FACTORIAL.cob
@@ -0,0 +1,16 @@
+       *> { dg-do run }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_FORMATTED-DATE.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_FORMATTED-DATE.cob

new file mode 100644 (file)

index 0000000..cde5644
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_FORMATTED-DATE.cob
@@ -0,0 +1,54 @@
+       *> { dg-do run }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_FORMATTED-DATETIME.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_FORMATTED-DATETIME.cob

new file mode 100644 (file)

index 0000000..47654cb
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_FORMATTED-DATETIME.cob
@@ -0,0 +1,48 @@
+       *> { dg-do run }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_FORMATTED-DATETIME_with_ref_modding.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_FORMATTED-DATETIME_with_ref_modding.cob

new file mode 100644 (file)

index 0000000..c440755
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_FORMATTED-DATETIME_with_ref_modding.cob
@@ -0,0 +1,17 @@
+       *> { dg-do run }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_FORMATTED-DATE_TIME_DATETIME.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_FORMATTED-DATE_TIME_DATETIME.cob

new file mode 100644 (file)

index 0000000..c495e0d
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_FORMATTED-DATE_TIME_DATETIME.cob
@@ -0,0 +1,69 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/FUNCTION_FORMATTED-DATE_TIME_DATETIME.out" }
+
+        IDENTIFICATION DIVISION.
+        PROGRAM-ID. datetime.
+        PROCEDURE DIVISION.
+        DISPLAY "FUNCTION FORMATTED-DATETIME - valid format strings"
+        DISPLAY "   FORMATTED-DATE Basic"
+        DISPLAY FUNCTION FORMATTED-DATE("YYYYMMDD"   128623).
+        DISPLAY FUNCTION FORMATTED-DATE("YYYYDDD"    128623).
+        DISPLAY FUNCTION FORMATTED-DATE("YYYYWwwD"   128623).
+        DISPLAY "   FORMATTED-DATE Extended"
+        DISPLAY FUNCTION FORMATTED-DATE("YYYY-MM-DD" 128623).
+        DISPLAY FUNCTION FORMATTED-DATE("YYYY-DDD"   128623).
+        DISPLAY FUNCTION FORMATTED-DATE("YYYY-Www-D" 128623).
+        DISPLAY "   FORMATTED-TIME Basic"
+        DISPLAY FUNCTION FORMATTED-TIME("hhmmss"                45296.987654321 -300).
+        DISPLAY FUNCTION FORMATTED-TIME("hhmmss+hhmm"           45296.987654321 -300).
+        DISPLAY FUNCTION FORMATTED-TIME("hhmmss.ssss"           45296.987654321 -300).
+        DISPLAY FUNCTION FORMATTED-TIME("hhmmss.ssss+hhmm"      45296.987654321 -300).
+        DISPLAY FUNCTION FORMATTED-TIME("hhmmss.ssssZ"          45296.987654321 -300).
+        DISPLAY FUNCTION FORMATTED-TIME("hhmmssZ"               45296.987654321 -300).
+        DISPLAY "   FORMATTED-TIME Extended"
+        DISPLAY FUNCTION FORMATTED-TIME("hh:mm:ss"              45296.987654321 -300).
+        DISPLAY FUNCTION FORMATTED-TIME("hh:mm:ss+hh:mm"        45296.987654321 -300).
+        DISPLAY FUNCTION FORMATTED-TIME("hh:mm:ss.ssss"         45296.987654321 -300).
+        DISPLAY FUNCTION FORMATTED-TIME("hh:mm:ss.ssss+hh:mm"   45296.987654321 -300).
+        DISPLAY FUNCTION FORMATTED-TIME("hh:mm:ss.ssssZ"        45296.987654321 -300).
+        DISPLAY FUNCTION FORMATTED-TIME("hh:mm:ssZ"             45296.987654321 -300).
+        DISPLAY "   FORMATTED-DATETIME Basic"
+        DISPLAY FUNCTION FORMATTED-DATETIME("YYYYMMDDThhmmss" 128623 45296.987654321 -300).
+        DISPLAY FUNCTION FORMATTED-DATETIME("YYYYMMDDThhmmss+hhmm" 128623 45296.987654321 -300).
+        DISPLAY FUNCTION FORMATTED-DATETIME("YYYYMMDDThhmmss.ssss" 128623 45296.987654321 -300).
+        DISPLAY FUNCTION FORMATTED-DATETIME("YYYYMMDDThhmmss.ssss+hhmm" 128623 45296.987654321 -300).
+        DISPLAY FUNCTION FORMATTED-DATETIME("YYYYMMDDThhmmss.ssssZ" 128623 45296.987654321 -300).
+        DISPLAY FUNCTION FORMATTED-DATETIME("YYYYMMDDThhmmssZ" 128623 45296.987654321 -300).
+        DISPLAY FUNCTION FORMATTED-DATETIME("YYYYDDDThhmmss" 128623 45296.987654321 -300).
+        DISPLAY FUNCTION FORMATTED-DATETIME("YYYYDDDThhmmss+hhmm" 128623 45296.987654321 -300).
+        DISPLAY FUNCTION FORMATTED-DATETIME("YYYYDDDThhmmss.ssss" 128623 45296.987654321 -300).
+        DISPLAY FUNCTION FORMATTED-DATETIME("YYYYDDDThhmmss.ssss+hhmm" 128623 45296.987654321 -300).
+        DISPLAY FUNCTION FORMATTED-DATETIME("YYYYDDDThhmmss.ssssZ" 128623 45296.987654321 -300).
+        DISPLAY FUNCTION FORMATTED-DATETIME("YYYYDDDThhmmssZ" 128623 45296.987654321 -300).
+        DISPLAY FUNCTION FORMATTED-DATETIME("YYYYWwwDThhmmss" 128623 45296.987654321 -300).
+        DISPLAY FUNCTION FORMATTED-DATETIME("YYYYWwwDThhmmss+hhmm" 128623 45296.987654321 -300).
+        DISPLAY FUNCTION FORMATTED-DATETIME("YYYYWwwDThhmmss.ssss" 128623 45296.987654321 -300).
+        DISPLAY FUNCTION FORMATTED-DATETIME("YYYYWwwDThhmmss.ssss+hhmm" 128623 45296.987654321 -300).
+        DISPLAY FUNCTION FORMATTED-DATETIME("YYYYWwwDThhmmss.ssssZ" 128623 45296.987654321 -300).
+        DISPLAY FUNCTION FORMATTED-DATETIME("YYYYWwwDThhmmssZ" 128623 45296.987654321 -300).
+        DISPLAY "   FORMATTED-DATETIME Extended"
+        DISPLAY FUNCTION FORMATTED-DATETIME("YYYY-MM-DDThh:mm:ss" 128623 45296.987654321 -300).
+        DISPLAY FUNCTION FORMATTED-DATETIME("YYYY-MM-DDThh:mm:ss+hh:mm" 128623 45296.987654321 -300).
+        DISPLAY FUNCTION FORMATTED-DATETIME("YYYY-MM-DDThh:mm:ss.ssss" 128623 45296.987654321 -300).
+        DISPLAY FUNCTION FORMATTED-DATETIME("YYYY-MM-DDThh:mm:ss.ssss+hh:mm" 128623 45296.987654321 -300).
+        DISPLAY FUNCTION FORMATTED-DATETIME("YYYY-MM-DDThh:mm:ss.ssssZ" 128623 45296.987654321 -300).
+        DISPLAY FUNCTION FORMATTED-DATETIME("YYYY-MM-DDThh:mm:ssZ" 128623 45296.987654321 -300).
+        DISPLAY FUNCTION FORMATTED-DATETIME("YYYY-DDDThh:mm:ss" 128623 45296.987654321 -300).
+        DISPLAY FUNCTION FORMATTED-DATETIME("YYYY-DDDThh:mm:ss+hh:mm" 128623 45296.987654321 -300).
+        DISPLAY FUNCTION FORMATTED-DATETIME("YYYY-DDDThh:mm:ss.ssss" 128623 45296.987654321 -300).
+        DISPLAY FUNCTION FORMATTED-DATETIME("YYYY-DDDThh:mm:ss.ssss+hh:mm" 128623 45296.987654321 -300).
+        DISPLAY FUNCTION FORMATTED-DATETIME("YYYY-DDDThh:mm:ss.ssssZ" 128623 45296.987654321 -300).
+        DISPLAY FUNCTION FORMATTED-DATETIME("YYYY-DDDThh:mm:ssZ" 128623 45296.987654321 -300).
+        DISPLAY FUNCTION FORMATTED-DATETIME("YYYY-Www-DThh:mm:ss" 128623 45296.987654321 -300).
+        DISPLAY FUNCTION FORMATTED-DATETIME("YYYY-Www-DThh:mm:ss+hh:mm" 128623 45296.987654321 -300).
+        DISPLAY FUNCTION FORMATTED-DATETIME("YYYY-Www-DThh:mm:ss.ssss" 128623 45296.987654321 -300).
+        DISPLAY FUNCTION FORMATTED-DATETIME("YYYY-Www-DThh:mm:ss.ssss+hh:mm" 128623 45296.987654321 -300).
+        DISPLAY FUNCTION FORMATTED-DATETIME("YYYY-Www-DThh:mm:ss.ssssZ" 128623 45296.987654321 -300).
+        DISPLAY FUNCTION FORMATTED-DATETIME("YYYY-Www-DThh:mm:ssZ" 128623 45296.987654321 -300).
+        END PROGRAM datetime.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_FORMATTED-DATE_TIME_DATETIME.out b/gcc/testsuite/cobol.dg/group2/FUNCTION_FORMATTED-DATE_TIME_DATETIME.out

new file mode 100644 (file)

index 0000000..5395f4e
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_FORMATTED-DATE_TIME_DATETIME.out
@@ -0,0 +1,62 @@
+FUNCTION FORMATTED-DATETIME - valid format strings
+   FORMATTED-DATE Basic
+19530227
+1953058
+1953W095
+   FORMATTED-DATE Extended
+1953-02-27
+1953-058
+1953-W09-5
+   FORMATTED-TIME Basic
+123456
+123456-0500
+123456.9876
+123456.9876-0500
+173456.0000Z
+173456Z
+   FORMATTED-TIME Extended
+12:34:56
+12:34:56-05:00
+12:34:56.9876
+12:34:56.9876-05:00
+17:34:56.0000Z
+17:34:56Z
+   FORMATTED-DATETIME Basic
+19530227T123456
+19530227T123456-0500
+19530227T123456.9876
+19530227T123456.9876-0500
+19530227T173456.0000Z
+19530227T173456Z
+1953058T123456
+1953058T123456-0500
+1953058T123456.9876
+1953058T123456.9876-0500
+1953058T173456.0000Z
+1953058T173456Z
+1953W095T123456
+1953W095T123456-0500
+1953W095T123456.9876
+1953W095T123456.9876-0500
+1953W095T173456.0000Z
+1953W095T173456Z
+   FORMATTED-DATETIME Extended
+1953-02-27T12:34:56
+1953-02-27T12:34:56-05:00
+1953-02-27T12:34:56.9876
+1953-02-27T12:34:56.9876-05:00
+1953-02-27T17:34:56.0000Z
+1953-02-27T17:34:56Z
+1953-058T12:34:56
+1953-058T12:34:56-05:00
+1953-058T12:34:56.9876
+1953-058T12:34:56.9876-05:00
+1953-058T17:34:56.0000Z
+1953-058T17:34:56Z
+1953-W09-5T12:34:56
+1953-W09-5T12:34:56-05:00
+1953-W09-5T12:34:56.9876
+1953-W09-5T12:34:56.9876-05:00
+1953-W09-5T17:34:56.0000Z
+1953-W09-5T17:34:56Z
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_FORMATTED-DATE_with_ref_modding.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_FORMATTED-DATE_with_ref_modding.cob

new file mode 100644 (file)

index 0000000..ac5c828
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_FORMATTED-DATE_with_ref_modding.cob
@@ -0,0 +1,16 @@
+       *> { dg-do run }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_FORMATTED-TIME_DP.COMMA.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_FORMATTED-TIME_DP.COMMA.cob

new file mode 100644 (file)

index 0000000..1abd625
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_FORMATTED-TIME_DP.COMMA.cob
@@ -0,0 +1,22 @@
+       *> { dg-do run }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_FORMATTED-TIME_with_ref_modding.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_FORMATTED-TIME_with_ref_modding.cob

new file mode 100644 (file)

index 0000000..cfcf0c7
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_FORMATTED-TIME_with_ref_modding.cob
@@ -0,0 +1,16 @@
+       *> { dg-do run }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_FRACTION-PART.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_FRACTION-PART.cob

new file mode 100644 (file)

index 0000000..65f341b
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_FRACTION-PART.cob
@@ -0,0 +1,22 @@
+       *> { dg-do run }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_HEX-OF.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_HEX-OF.cob

new file mode 100644 (file)

index 0000000..ed31eb6
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_HEX-OF.cob
@@ -0,0 +1,13 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/FUNCTION_HEX-OF.out" }
+
+        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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_HEX-OF.out b/gcc/testsuite/cobol.dg/group2/FUNCTION_HEX-OF.out

new file mode 100644 (file)

index 0000000..40892ac
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_HEX-OF.out
@@ -0,0 +1,3 @@
+48656C6C6F2C20776F726C6421
+12345F
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_HIGHEST-ALGEBRAIC.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_HIGHEST-ALGEBRAIC.cob

new file mode 100644 (file)

index 0000000..2e59df3
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_HIGHEST-ALGEBRAIC.cob
@@ -0,0 +1,76 @@
+       *> { dg-do run }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_INTEGER-OF-DATE.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_INTEGER-OF-DATE.cob

new file mode 100644 (file)

index 0000000..4632864
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_INTEGER-OF-DATE.cob
@@ -0,0 +1,16 @@
+       *> { dg-do run }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_INTEGER-OF-DAY.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_INTEGER-OF-DAY.cob

new file mode 100644 (file)

index 0000000..38162bf
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_INTEGER-OF-DAY.cob
@@ -0,0 +1,16 @@
+       *> { dg-do run }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_INTEGER-OF-FORMATTED-DATE.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_INTEGER-OF-FORMATTED-DATE.cob

new file mode 100644 (file)

index 0000000..d580ea8
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_INTEGER-OF-FORMATTED-DATE.cob
@@ -0,0 +1,41 @@
+       *> { dg-do run }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_INTEGER-PART.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_INTEGER-PART.cob

new file mode 100644 (file)

index 0000000..cc97765
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_INTEGER-PART.cob
@@ -0,0 +1,17 @@
+       *> { dg-do run }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_INTEGER.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_INTEGER.cob

new file mode 100644 (file)

index 0000000..d43dd08
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_INTEGER.cob
@@ -0,0 +1,24 @@
+       *> { dg-do run }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_LENGTH__1_.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_LENGTH__1_.cob

new file mode 100644 (file)

index 0000000..8bbf689
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_LENGTH__1_.cob
@@ -0,0 +1,38 @@
+       *> { dg-do run }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_LENGTH__2_.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_LENGTH__2_.cob

new file mode 100644 (file)

index 0000000..9416ca0
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_LENGTH__2_.cob
@@ -0,0 +1,139 @@
+       *> { dg-do run }
+       *> { dg-options "-dialect ibm" }
+       *> { dg-output-file "group2/FUNCTION_LENGTH__2_.out" }
+        program-id. prog.
+        data division.
+        working-storage section.
+        01      desc1.
+         05     desc1-entry pic x(5) occurs 10.
+
+        01      desc2.
+         05     desc2-table occurs 10 times.
+          10    desc2-entry pic x(5).
+
+        01      desc3.
+         05     desc3-outer occurs 1 to 5 times depending on desc3-lim.
+          10    desc3-outer-txt   pic x(7).
+          10    desc3-inner occurs 11 times.
+           15   desc3-inner-text  pic x(13).
+        77 desc3-lim binary-long.
+
+        77      msg pic x(64).
+        77      should-be pic zzzz9.
+        77      but-is    pic zzzz9.
+        
+        procedure division.
+
+        display "using FUNCTION LENGTH"
+
+        move    "function length(desc1)" to msg
+        move    50 to should-be
+        move    function length(desc1) to but-is
+        perform result-is
+
+        move    "function length(desc1-entry)" to msg
+        move    50 to should-be
+        move    function length(desc1-entry) to but-is
+        perform result-is
+
+        move    "function length(desc1-entry(1))" to msg
+        move    5 to should-be
+        move    function length(desc1-entry(1)) to but-is
+        perform result-is
+
+        move    "function length(desc2)" to msg
+        move    50 to should-be
+        move    function length(desc2) to but-is
+        perform result-is
+        
+        move    "function length(desc2-table)" to msg
+        move    50 to should-be
+        move    function length(desc2-table) to but-is
+        perform result-is
+
+        move    "function length(desc2-entry)" to msg
+        move    5 to should-be
+        move    function length(desc2-entry) to but-is
+        perform result-is
+
+        move    "function length(desc2-entry(1))" to msg
+        move    5 to should-be
+        move    function length(desc2-entry(1)) to but-is
+        perform result-is
+
+        move    5 to desc3-lim
+
+        move    "function length(desc3)" to msg
+        move    750 to should-be
+        move    function length(desc3) to but-is
+        perform result-is
+
+        move    "function length(desc3-outer)" to msg
+        move    750 to should-be
+        move    function length(desc3-outer) to but-is
+        perform result-is
+
+        move    "function length(desc3-outer(1))" to msg
+        move    150 to should-be
+        move    function length(desc3-outer(1)) to but-is
+        perform result-is
+
+        move    "function length(desc3-outer-txt)" to msg
+        move    7 to should-be
+        move    function length(desc3-outer-txt) to but-is
+        perform result-is
+
+        move    "function length(desc3-inner)" to msg
+        move    143 to should-be
+        move    function length(desc3-inner) to but-is
+        perform result-is
+
+        move    "function length(desc3-inner(1))" to msg
+        move    13 to should-be
+        move    function length(desc3-inner(1)) to but-is
+        perform result-is
+
+        display "After changing desc3-lim from 5 to 3..."
+        move    3 to desc3-lim
+
+        move    "function length(desc3)" to msg
+        move    450 to should-be
+        move    function length(desc3) to but-is
+        perform result-is
+
+        move    "function length(desc3-outer)" to msg
+        move    450 to should-be
+        move    function length(desc3-outer) to but-is
+        perform result-is
+
+        move    "function length(desc3-outer(1))" to msg
+        move    150 to should-be
+        move    function length(desc3-outer(1)) to but-is
+        perform result-is
+
+        move    "function length(desc3-outer-txt)" to msg
+        move    7 to should-be
+        move    function length(desc3-outer-txt) to but-is
+        perform result-is
+
+        move    "function length(desc3-inner)" to msg
+        move    143 to should-be
+        move    function length(desc3-inner) to but-is
+        perform result-is
+
+        move    "function length(desc3-inner(1))" to msg
+        move    13 to should-be
+        move    function length(desc3-inner(1)) to but-is
+        perform result-is
+
+        goback.
+        result-is.
+        display function trim(msg) ": " with no advancing
+        if but-is equal to should-be
+            display function trim(but-is)
+        else
+            display "should be " function trim(should-be)
+                    " but is "   function trim(but-is)
+        end-if.
+        end program prog.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_LENGTH__2_.out b/gcc/testsuite/cobol.dg/group2/FUNCTION_LENGTH__2_.out

new file mode 100644 (file)

index 0000000..9d90261
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_LENGTH__2_.out
@@ -0,0 +1,22 @@
+using FUNCTION LENGTH
+function length(desc1): 50
+function length(desc1-entry): 50
+function length(desc1-entry(1)): 5
+function length(desc2): 50
+function length(desc2-table): 50
+function length(desc2-entry): 5
+function length(desc2-entry(1)): 5
+function length(desc3): 750
+function length(desc3-outer): 750
+function length(desc3-outer(1)): 150
+function length(desc3-outer-txt): 7
+function length(desc3-inner): 143
+function length(desc3-inner(1)): 13
+After changing desc3-lim from 5 to 3...
+function length(desc3): 450
+function length(desc3-outer): 450
+function length(desc3-outer(1)): 150
+function length(desc3-outer-txt): 7
+function length(desc3-inner): 143
+function length(desc3-inner(1)): 13
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_LOCALE-COMPARE.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_LOCALE-COMPARE.cob

new file mode 100644 (file)

index 0000000..cb6d783
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_LOCALE-COMPARE.cob
@@ -0,0 +1,21 @@
+       *> { dg-do run }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_LOCALE-DATE.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_LOCALE-DATE.cob

new file mode 100644 (file)

index 0000000..35e0729
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_LOCALE-DATE.cob
@@ -0,0 +1,16 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/FUNCTION_LOCALE-DATE.out" }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_LOCALE-DATE.out b/gcc/testsuite/cobol.dg/group2/FUNCTION_LOCALE-DATE.out

new file mode 100644 (file)

index 0000000..885fd66
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_LOCALE-DATE.out
@@ -0,0 +1,2 @@
+OK
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_LOCALE-TIME-FROM-SECONDS.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_LOCALE-TIME-FROM-SECONDS.cob

new file mode 100644 (file)

index 0000000..d04e7a9
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_LOCALE-TIME-FROM-SECONDS.cob
@@ -0,0 +1,16 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/FUNCTION_LOCALE-TIME-FROM-SECONDS.out" }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_LOCALE-TIME-FROM-SECONDS.out b/gcc/testsuite/cobol.dg/group2/FUNCTION_LOCALE-TIME-FROM-SECONDS.out

new file mode 100644 (file)

index 0000000..885fd66
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_LOCALE-TIME-FROM-SECONDS.out
@@ -0,0 +1,2 @@
+OK
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_LOCALE-TIME.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_LOCALE-TIME.cob

new file mode 100644 (file)

index 0000000..aeba184
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_LOCALE-TIME.cob
@@ -0,0 +1,16 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/FUNCTION_LOCALE-TIME.out" }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_LOCALE-TIME.out b/gcc/testsuite/cobol.dg/group2/FUNCTION_LOCALE-TIME.out

new file mode 100644 (file)

index 0000000..885fd66
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_LOCALE-TIME.out
@@ -0,0 +1,2 @@
+OK
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_LOG.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_LOG.cob

new file mode 100644 (file)

index 0000000..f0ab0e7
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_LOG.cob
@@ -0,0 +1,15 @@
+       *> { dg-do run }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_LOG10.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_LOG10.cob

new file mode 100644 (file)

index 0000000..e37210b
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_LOG10.cob
@@ -0,0 +1,15 @@
+       *> { dg-do run }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_LOWER-CASE.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_LOWER-CASE.cob

new file mode 100644 (file)

index 0000000..4cf24d5
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_LOWER-CASE.cob
@@ -0,0 +1,19 @@
+       *> { dg-do run }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_LOWER-CASE_with_reference_modding.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_LOWER-CASE_with_reference_modding.cob

new file mode 100644 (file)

index 0000000..eb53ca4
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_LOWER-CASE_with_reference_modding.cob
@@ -0,0 +1,17 @@
+       *> { dg-do run }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_LOWEST-ALGEBRAIC.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_LOWEST-ALGEBRAIC.cob

new file mode 100644 (file)

index 0000000..4750c7e
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_LOWEST-ALGEBRAIC.cob
@@ -0,0 +1,55 @@
+       *> { dg-do run }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_MAX.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_MAX.cob

new file mode 100644 (file)

index 0000000..99971a9
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_MAX.cob
@@ -0,0 +1,12 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/FUNCTION_MAX.out" }
+
+       IDENTIFICATION   DIVISION.
+       PROGRAM-ID.      prog.
+       DATA             DIVISION.
+       WORKING-STORAGE  SECTION.
+       PROCEDURE        DIVISION.
+           DISPLAY FUNCTION MAX ( 3 -14 0 8 -3 )
+           END-DISPLAY.
+           STOP RUN.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_MAX.out b/gcc/testsuite/cobol.dg/group2/FUNCTION_MAX.out

new file mode 100644 (file)

index 0000000..2f95459
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_MAX.out
@@ -0,0 +1,2 @@
+8
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_MEAN.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_MEAN.cob

new file mode 100644 (file)

index 0000000..007f235
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_MEAN.cob
@@ -0,0 +1,14 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/FUNCTION_MEAN.out" }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_MEAN.out b/gcc/testsuite/cobol.dg/group2/FUNCTION_MEAN.out

new file mode 100644 (file)

index 0000000..7f05c89
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_MEAN.out
@@ -0,0 +1,2 @@
+-001.200
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_MEDIAN.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_MEDIAN.cob

new file mode 100644 (file)

index 0000000..ac2515d
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_MEDIAN.cob
@@ -0,0 +1,12 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/FUNCTION_MEDIAN.out" }
+
+       IDENTIFICATION   DIVISION.
+       PROGRAM-ID.      prog.
+       DATA             DIVISION.
+       WORKING-STORAGE  SECTION.
+       PROCEDURE        DIVISION.
+           DISPLAY FUNCTION MEDIAN ( 3 -14 0 8 -3 )
+           END-DISPLAY.
+           STOP RUN.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_MEDIAN.out b/gcc/testsuite/cobol.dg/group2/FUNCTION_MEDIAN.out

new file mode 100644 (file)

index 0000000..77ac542
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_MEDIAN.out
@@ -0,0 +1,2 @@
+0
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_MIDRANGE.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_MIDRANGE.cob

new file mode 100644 (file)

index 0000000..601cbc7
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_MIDRANGE.cob
@@ -0,0 +1,14 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/FUNCTION_MIDRANGE.out" }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_MIDRANGE.out b/gcc/testsuite/cobol.dg/group2/FUNCTION_MIDRANGE.out

new file mode 100644 (file)

index 0000000..6945d25
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_MIDRANGE.out
@@ -0,0 +1,2 @@
+-003.000
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_MIN.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_MIN.cob

new file mode 100644 (file)

index 0000000..85ef141
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_MIN.cob
@@ -0,0 +1,12 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/FUNCTION_MIN.out" }
+
+       IDENTIFICATION   DIVISION.
+       PROGRAM-ID.      prog.
+       DATA             DIVISION.
+       WORKING-STORAGE  SECTION.
+       PROCEDURE        DIVISION.
+           DISPLAY FUNCTION MIN ( 3 -14 0 8 -3 )
+           END-DISPLAY.
+           STOP RUN.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_MIN.out b/gcc/testsuite/cobol.dg/group2/FUNCTION_MIN.out

new file mode 100644 (file)

index 0000000..1bd872a
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_MIN.out
@@ -0,0 +1,2 @@
+-14
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_MODULE-NAME.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_MODULE-NAME.cob

new file mode 100644 (file)

index 0000000..cbb445f
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_MODULE-NAME.cob
@@ -0,0 +1,110 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/FUNCTION_MODULE-NAME.out" }
+
+        identification          division.
+        program-id.             level-1.
+        data                    division.
+        working-storage         section.
+        procedure               division.
+        display "From level-1:"
+        perform                 reportt.
+        call                    "level-2"
+        goback.
+        reportt.
+        display "   "  "top-level:  "  """" function module-name(top-level)  """"
+        display "   "  "current:    "  """" function module-name(current)    """"
+        display "   "  "activating: "  """" function module-name(activating) """"
+        display "   "  "nested:     "  """" function module-name(nested)     """"
+        display "   "  "stack:      "  """" function module-name(stack)      """"
+        continue.
+        end program             level-1.
+
+        identification          division.
+        program-id.             level-2.
+        data                    division.
+        working-storage         section.
+        procedure               division.
+        display "From level-2:"
+        perform                 reportt.
+        call "level-3"
+        goback.
+        reportt.
+        display "   "  "top-level:  "  """" function module-name(top-level)  """"
+        display "   "  "current:    "  """" function module-name(current)    """"
+        display "   "  "activating: "  """" function module-name(activating) """"
+        display "   "  "nested:     "  """" function module-name(nested)     """"
+        display "   "  "stack:      "  """" function module-name(stack)      """"
+        continue.
+        end program             level-2.
+
+        identification          division.
+        program-id.             level-3.
+        data                    division.
+        working-storage         section.
+        procedure               division.
+        display "From level-3:"
+        perform                 reportt.
+        call "level-3a"
+        goback.
+        reportt.
+        display "   "  "top-level:  "  """" function module-name(top-level)  """"
+        display "   "  "current:    "  """" function module-name(current)    """"
+        display "   "  "activating: "  """" function module-name(activating) """"
+        display "   "  "nested:     "  """" function module-name(nested)     """"
+        display "   "  "stack:      "  """" function module-name(stack)      """"
+        continue.
+
+        identification          division.
+        program-id.             level-3a.
+        data                    division.
+        working-storage         section.
+        procedure               division.
+        display "From level-3a:"
+        perform                 reportt.
+        call "level-3b"
+        goback.
+        reportt.
+        display "   "  "top-level:  "  """" function module-name(top-level)  """"
+        display "   "  "current:    "  """" function module-name(current)    """"
+        display "   "  "activating: "  """" function module-name(activating) """"
+        display "   "  "nested:     "  """" function module-name(nested)     """"
+        display "   "  "stack:      "  """" function module-name(stack)      """"
+        continue.
+        
+        identification          division.
+        program-id.             level-3b.
+        data                    division.
+        working-storage         section.
+        procedure               division.
+        display "From level-3b:"
+        perform                 reportt.
+        call "level-3c"
+        goback.
+        reportt.
+        display "   "  "top-level:  "  """" function module-name(top-level)  """"
+        display "   "  "current:    "  """" function module-name(current)    """"
+        display "   "  "activating: "  """" function module-name(activating) """"
+        display "   "  "nested:     "  """" function module-name(nested)     """"
+        display "   "  "stack:      "  """" function module-name(stack)      """"
+        continue.
+
+        identification          division.
+        program-id.             level-3c.
+        data                    division.
+        working-storage         section.
+        procedure               division.
+        display "From level-3c:"
+        perform                 reportt.
+        goback.
+        reportt.
+        display "   "  "top-level:  "  """" function module-name(top-level)  """"
+        display "   "  "current:    "  """" function module-name(current)    """"
+        display "   "  "activating: "  """" function module-name(activating) """"
+        display "   "  "nested:     "  """" function module-name(nested)     """"
+        display "   "  "stack:      "  """" function module-name(stack)      """"
+        continue.
+        end program             level-3c.
+        end program             level-3b.
+        end program             level-3a.
+        end program             level-3.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_MODULE-NAME.out b/gcc/testsuite/cobol.dg/group2/FUNCTION_MODULE-NAME.out

new file mode 100644 (file)

index 0000000..7be80f0
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_MODULE-NAME.out
@@ -0,0 +1,37 @@
+From level-1:
+   top-level:  "level-1"
+   current:    "level-1"
+   activating: " "
+   nested:     "level-1"
+   stack:      "level-1; "
+From level-2:
+   top-level:  "level-1"
+   current:    "level-2"
+   activating: "level-1"
+   nested:     "level-2"
+   stack:      "level-2;level-1; "
+From level-3:
+   top-level:  "level-1"
+   current:    "level-3"
+   activating: "level-2"
+   nested:     "level-3"
+   stack:      "level-3;level-2;level-1; "
+From level-3a:
+   top-level:  "level-1"
+   current:    "level-3"
+   activating: "level-3"
+   nested:     "level-3a"
+   stack:      "level-3a;level-3;level-2;level-1; "
+From level-3b:
+   top-level:  "level-1"
+   current:    "level-3"
+   activating: "level-3a"
+   nested:     "level-3b"
+   stack:      "level-3b;level-3a;level-3;level-2;level-1; "
+From level-3c:
+   top-level:  "level-1"
+   current:    "level-3"
+   activating: "level-3b"
+   nested:     "level-3c"
+   stack:      "level-3c;level-3b;level-3a;level-3;level-2;level-1; "
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_MOD__invalid_.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_MOD__invalid_.cob

new file mode 100644 (file)

index 0000000..56ecbcd
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_MOD__invalid_.cob
@@ -0,0 +1,22 @@
+       *> { dg-do run }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_MOD__valid_.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_MOD__valid_.cob

new file mode 100644 (file)

index 0000000..0db8679
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_MOD__valid_.cob
@@ -0,0 +1,21 @@
+       *> { dg-do run }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_NUMVAL-C.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_NUMVAL-C.cob

new file mode 100644 (file)

index 0000000..2eb8eb9
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_NUMVAL-C.cob
@@ -0,0 +1,22 @@
+       *> { dg-do run }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_NUMVAL-C_DP.COMMA.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_NUMVAL-C_DP.COMMA.cob

new file mode 100644 (file)

index 0000000..bd57463
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_NUMVAL-C_DP.COMMA.cob
@@ -0,0 +1,21 @@
+       *> { dg-do run }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_NUMVAL-F.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_NUMVAL-F.cob

new file mode 100644 (file)

index 0000000..522f810
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_NUMVAL-F.cob
@@ -0,0 +1,30 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/FUNCTION_NUMVAL-F.out" }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_NUMVAL-F.out b/gcc/testsuite/cobol.dg/group2/FUNCTION_NUMVAL-F.out

new file mode 100644 (file)

index 0000000..6d27dd2
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_NUMVAL-F.out
@@ -0,0 +1,8 @@
+" - 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
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_NUMVAL.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_NUMVAL.cob

new file mode 100644 (file)

index 0000000..9288331
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_NUMVAL.cob
@@ -0,0 +1,22 @@
+       *> { dg-do run }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_ORD-MAX.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_ORD-MAX.cob

new file mode 100644 (file)

index 0000000..0dd1053
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_ORD-MAX.cob
@@ -0,0 +1,14 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/FUNCTION_ORD-MAX.out" }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_ORD-MAX.out b/gcc/testsuite/cobol.dg/group2/FUNCTION_ORD-MAX.out

new file mode 100644 (file)

index 0000000..c9ce4ea
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_ORD-MAX.out
@@ -0,0 +1,2 @@
+004
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_ORD-MIN.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_ORD-MIN.cob

new file mode 100644 (file)

index 0000000..fd55396
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_ORD-MIN.cob
@@ -0,0 +1,14 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/FUNCTION_ORD-MIN.out" }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_ORD-MIN.out b/gcc/testsuite/cobol.dg/group2/FUNCTION_ORD-MIN.out

new file mode 100644 (file)

index 0000000..4119821
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_ORD-MIN.out
@@ -0,0 +1,2 @@
+002
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_ORD.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_ORD.cob

new file mode 100644 (file)

index 0000000..fe5e290
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_ORD.cob
@@ -0,0 +1,14 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/FUNCTION_ORD.out" }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_ORD.out b/gcc/testsuite/cobol.dg/group2/FUNCTION_ORD.out

new file mode 100644 (file)

index 0000000..e55677a
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_ORD.out
@@ -0,0 +1,2 @@
+108
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_PI.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_PI.cob

new file mode 100644 (file)

index 0000000..9792e03
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_PI.cob
@@ -0,0 +1,15 @@
+       *> { dg-do run }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_PRESENT-VALUE.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_PRESENT-VALUE.cob

new file mode 100644 (file)

index 0000000..5883abd
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_PRESENT-VALUE.cob
@@ -0,0 +1,14 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/FUNCTION_PRESENT-VALUE.out" }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_PRESENT-VALUE.out b/gcc/testsuite/cobol.dg/group2/FUNCTION_PRESENT-VALUE.out

new file mode 100644 (file)

index 0000000..52ce840
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_PRESENT-VALUE.out
@@ -0,0 +1,2 @@
+00000.5625
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_RANDOM.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_RANDOM.cob

new file mode 100644 (file)

index 0000000..0a3e151
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_RANDOM.cob
@@ -0,0 +1,15 @@
+       *> { dg-do run }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_RANGE.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_RANGE.cob

new file mode 100644 (file)

index 0000000..48a9511
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_RANGE.cob
@@ -0,0 +1,15 @@
+       *> { dg-do run }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_REM__invalid_.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_REM__invalid_.cob

new file mode 100644 (file)

index 0000000..38298a8
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_REM__invalid_.cob
@@ -0,0 +1,22 @@
+       *> { dg-do run }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_REM__valid_.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_REM__valid_.cob

new file mode 100644 (file)

index 0000000..7ace4a2
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_REM__valid_.cob
@@ -0,0 +1,14 @@
+       *> { dg-do run }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_REVERSE.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_REVERSE.cob

new file mode 100644 (file)

index 0000000..b1b1690
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_REVERSE.cob
@@ -0,0 +1,16 @@
+       *> { dg-do run }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_REVERSE_with_reference_modding.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_REVERSE_with_reference_modding.cob

new file mode 100644 (file)

index 0000000..98c28ad
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_REVERSE_with_reference_modding.cob
@@ -0,0 +1,16 @@
+       *> { dg-do run }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_SECONDS-FROM-FORMATTED-TIME.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_SECONDS-FROM-FORMATTED-TIME.cob

new file mode 100644 (file)

index 0000000..2641e08
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_SECONDS-FROM-FORMATTED-TIME.cob
@@ -0,0 +1,58 @@
+       *> { dg-do run }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_SECONDS-PAST-MIDNIGHT.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_SECONDS-PAST-MIDNIGHT.cob

new file mode 100644 (file)

index 0000000..b229ac3
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_SECONDS-PAST-MIDNIGHT.cob
@@ -0,0 +1,15 @@
+       *> { dg-do run }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_SIGN.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_SIGN.cob

new file mode 100644 (file)

index 0000000..f698d97
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_SIGN.cob
@@ -0,0 +1,30 @@
+       *> { dg-do run }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_SIN.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_SIN.cob

new file mode 100644 (file)

index 0000000..a72df35
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_SIN.cob
@@ -0,0 +1,15 @@
+       *> { dg-do run }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_SQRT.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_SQRT.cob

new file mode 100644 (file)

index 0000000..ddf36da
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_SQRT.cob
@@ -0,0 +1,15 @@
+       *> { dg-do run }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_STANDARD-DEVIATION.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_STANDARD-DEVIATION.cob

new file mode 100644 (file)

index 0000000..8deadc7
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_STANDARD-DEVIATION.cob
@@ -0,0 +1,15 @@
+       *> { dg-do run }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_SUBSTITUTE-CASE.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_SUBSTITUTE-CASE.cob

new file mode 100644 (file)

index 0000000..850f1da
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_SUBSTITUTE-CASE.cob
@@ -0,0 +1,19 @@
+       *> { dg-do run }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_SUBSTITUTE-CASE_with_reference_mod.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_SUBSTITUTE-CASE_with_reference_mod.cob

new file mode 100644 (file)

index 0000000..24ed1b8
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_SUBSTITUTE-CASE_with_reference_mod.cob
@@ -0,0 +1,20 @@
+       *> { dg-do run }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_SUBSTITUTE.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_SUBSTITUTE.cob

new file mode 100644 (file)

index 0000000..072c159
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_SUBSTITUTE.cob
@@ -0,0 +1,24 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/FUNCTION_SUBSTITUTE.out" }
+
+       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")
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_SUBSTITUTE.out b/gcc/testsuite/cobol.dg/group2/FUNCTION_SUBSTITUTE.out

new file mode 100644 (file)

index 0000000..4f5f7a0
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_SUBSTITUTE.out
@@ -0,0 +1,6 @@
+zz1114446665defxxzz
+FILLERBobZJimFILLERBobZJim
+FILLERBobZJimbobBobZJim
+bobBobZJimFILLERBobZJim
+FILLERFILLERZZFILLERFILLERZZ
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_SUBSTITUTE_with_reference_modding.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_SUBSTITUTE_with_reference_modding.cob

new file mode 100644 (file)

index 0000000..7894915
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_SUBSTITUTE_with_reference_modding.cob
@@ -0,0 +1,19 @@
+       *> { dg-do run }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_SUM.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_SUM.cob

new file mode 100644 (file)

index 0000000..228e996
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_SUM.cob
@@ -0,0 +1,15 @@
+       *> { dg-do run }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_TAN.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_TAN.cob

new file mode 100644 (file)

index 0000000..f932157
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_TAN.cob
@@ -0,0 +1,15 @@
+       *> { dg-do run }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-DATE-YYYYMMDD.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-DATE-YYYYMMDD.cob

new file mode 100644 (file)

index 0000000..8841f5a
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-DATE-YYYYMMDD.cob
@@ -0,0 +1,14 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/FUNCTION_TEST-DATE-YYYYMMDD.out" }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-DATE-YYYYMMDD.out b/gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-DATE-YYYYMMDD.out

new file mode 100644 (file)

index 0000000..56fa706
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-DATE-YYYYMMDD.out
@@ -0,0 +1,2 @@
+003
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-DAY-YYYYDDD__1_.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-DAY-YYYYDDD__1_.cob

new file mode 100644 (file)

index 0000000..71fbdb9
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-DAY-YYYYDDD__1_.cob
@@ -0,0 +1,14 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/FUNCTION_TEST-DAY-YYYYDDD__1_.out" }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-DAY-YYYYDDD__1_.out b/gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-DAY-YYYYDDD__1_.out

new file mode 100644 (file)

index 0000000..4119821
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-DAY-YYYYDDD__1_.out
@@ -0,0 +1,2 @@
+002
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-DAY-YYYYDDD__2_.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-DAY-YYYYDDD__2_.cob

new file mode 100644 (file)

index 0000000..24893ab
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-DAY-YYYYDDD__2_.cob
@@ -0,0 +1,170 @@
+       *> { dg-do run }
+
+        identification division.
+        program-id. test.
+        data division.
+        working-storage section.
+        01 datev     pic 99999999.
+        01 should_be pic 9999.
+        01 result    pic 9999.
+        procedure division.
+        move function test-day-yyyyddd(1945123) to result
+        move zero to should_be
+        if result not equal to should_be then
+            display "test-day-yyyyddd(1945123) should have been "
+                    should_be " but was " result
+            move 1 to return-code
+            end-if.
+        move function test-day-yyyyddd(10000000) to result
+        move 1 to should_be
+        if result not equal to should_be then
+            display "test-day-yyyyddd(100000000) should have been "
+                    should_be " but was " result
+            move 1 to return-code
+            end-if.
+        move 1601000 to datev
+        move 2 to should_be
+        move function test-day-yyyyddd(datev) to result
+        if result not equal to should_be then
+            display "test-day-yyyyddd(" datev ") should have been "
+                    should_be " but was " result
+            move 1 to return-code
+            end-if.
+        move 1601001 to datev
+        move zero to should_be
+        move function test-day-yyyyddd(datev) to result
+        if result not equal to should_be then
+            display "test-day-yyyyddd(" datev ") should have been "
+                    should_be " but was " result
+            move 1 to return-code
+            end-if.
+        move 1601364 to datev
+        move zero to should_be
+        move function test-day-yyyyddd(datev) to result
+        if result not equal to should_be then
+            display "test-day-yyyyddd(" datev ") should have been "
+                    should_be " but was " result
+            move 1 to return-code
+            end-if.
+        move 1601365 to datev
+        move zero to should_be
+        move function test-day-yyyyddd(datev) to result
+        if result not equal to should_be then
+            display "test-day-yyyyddd(" datev ") should have been "
+                    should_be " but was " result
+            move 1 to return-code
+            end-if.
+        move 1601366 to datev
+        move 2 to should_be
+        move function test-day-yyyyddd(datev) to result
+        if result not equal to should_be then
+            display "test-day-yyyyddd(" datev ") should have been "
+                    should_be " but was " result
+            move 1 to return-code
+            end-if.
+        move 1601367 to datev
+        move 2 to should_be
+        move function test-day-yyyyddd(datev) to result
+        if result not equal to should_be then
+            display "test-day-yyyyddd(" datev ") should have been "
+                    should_be " but was " result
+            move 1 to return-code
+            end-if.
+        move 2000365 to datev
+        move zero to should_be
+        move function test-day-yyyyddd(datev) to result
+        if result not equal to should_be then
+            display "test-day-yyyyddd(" datev ") should have been "
+                    should_be " but was " result
+            move 1 to return-code
+            end-if.
+        move 2000366 to datev
+        move zero to should_be
+        move function test-day-yyyyddd(datev) to result
+        if result not equal to should_be then
+            display "test-day-yyyyddd(" datev ") should have been "
+                    should_be " but was " result
+            move 1 to return-code
+            end-if.
+        move 2000367 to datev
+        move 2 to should_be
+        move function test-day-yyyyddd(datev) to result
+        if result not equal to should_be then
+            display "test-day-yyyyddd(" datev ") should have been "
+                    should_be " but was " result
+            move 1 to return-code
+            end-if.
+        move 2100365 to datev
+        move zero to should_be
+        move function test-day-yyyyddd(datev) to result
+        if result not equal to should_be then
+            display "test-day-yyyyddd(" datev ") should have been "
+                    should_be " but was " result
+            move 1 to return-code
+            end-if.
+        move 2100366 to datev
+        move 2 to should_be
+        move function test-day-yyyyddd(datev) to result
+        if result not equal to should_be then
+            display "test-day-yyyyddd(" datev ") should have been "
+                    should_be " but was " result
+            move 1 to return-code
+            end-if.
+        move 2100367 to datev
+        move 2 to should_be
+        move function test-day-yyyyddd(datev) to result
+        if result not equal to should_be then
+            display "test-day-yyyyddd(" datev ") should have been "
+                    should_be " but was " result
+            move 1 to return-code
+            end-if.
+        move 1988365 to datev
+        move zero to should_be
+        move function test-day-yyyyddd(datev) to result
+        if result not equal to should_be then
+            display "test-day-yyyyddd(" datev ") should have been "
+                    should_be " but was " result
+            move 1 to return-code
+            end-if.
+        move 1988366 to datev
+        move zero to should_be
+        move function test-day-yyyyddd(datev) to result
+        if result not equal to should_be then
+            display "test-day-yyyyddd(" datev ") should have been "
+                    should_be " but was " result
+            move 1 to return-code
+            end-if.
+        move 1988367 to datev
+        move 2 to should_be
+        move function test-day-yyyyddd(datev) to result
+        if result not equal to should_be then
+            display "test-day-yyyyddd(" datev ") should have been "
+                    should_be " but was " result
+            move 1 to return-code
+            end-if.
+        move 1989365 to datev
+        move zero to should_be
+        move function test-day-yyyyddd(datev) to result
+        if result not equal to should_be then
+            display "test-day-yyyyddd(" datev ") should have been "
+                    should_be " but was " result
+            move 1 to return-code
+            end-if.
+        move 1989366 to datev
+        move 2 to should_be
+        move function test-day-yyyyddd(datev) to result
+        if result not equal to should_be then
+            display "test-day-yyyyddd(" datev ") should have been "
+                    should_be " but was " result
+            move 1 to return-code
+            end-if.
+        move 1989367 to datev
+        move 2 to should_be
+        move function test-day-yyyyddd(datev) to result
+        if result not equal to should_be then
+            display "test-day-yyyyddd(" datev ") should have been "
+                    should_be " but was " result
+            move 1 to return-code
+            end-if.
+        end program test.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-FORMATTED-DATETIME_DP.COMMA.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-FORMATTED-DATETIME_DP.COMMA.cob

new file mode 100644 (file)

index 0000000..b825198
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-FORMATTED-DATETIME_DP.COMMA.cob
@@ -0,0 +1,32 @@
+       *> { dg-do run }
+
+        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
+            .
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-FORMATTED-DATETIME_additional.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-FORMATTED-DATETIME_additional.cob

new file mode 100644 (file)

index 0000000..e782647
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-FORMATTED-DATETIME_additional.cob
@@ -0,0 +1,173 @@
+       *> { dg-do run }
+
+        identification division.
+        program-id. test.
+        data division.
+        working-storage section.
+        01 datev    pic 99999999.
+        01 should_be pic 9999.
+        01 result    pic 9999.
+        01 date-integer PIC 999999.
+        01 i PIC 999.
+        01 datex PIC X(8).
+        01 xone    PIC  X.
+        01 yyyydddv .
+            02 yyyy   PIC 9999.
+            02 filler PIC X VALUE "-".
+            02 ddd    PIC 999.
+        procedure division.
+      *>    TESTING YYYYMMDD
+        move "19000229" to datex
+        move function TEST-FORMATTED-DATETIME("YYYYMMDD", datex) to RESULT
+        move 8 to should_be
+        if result not equal to should_be then
+            display "TEST-FORMATTED-DATETIME("
+                    """YYYYMMDD"""
+                    ", "
+                    function trim(datex)
+                    ") should have been "
+                    should_be " but was " result
+            move 1 to return-code
+            end-if.
+      *>    Test an entire year of YYYYMMDD:
+        move function integer-of-date(19880101) to date-integer
+        perform until date-integer >= function integer-of-date(19890101)
+            move function date-of-integer(date-integer) to datev
+            move function TEST-FORMATTED-DATETIME("YYYYMMDD", datev) to RESULT
+            move zero to should_be
+            if result not equal to should_be then
+                display "TEST-FORMATTED-DATETIME("
+                        """YYYYMMDD"""
+                        ", "
+                        datev
+                        ") should have been "
+                        should_be " but was " result
+                move 1 to return-code
+                end-if
+            add 1 to date-integer
+            end-perform.
+      *> Make sure foreign characters trigger the correct gazinga in YYYYMMDD
+        move "19530227" to datex
+        perform varying i from 1 by 1 until i > 8
+            move datex(i:1) to xone
+            move 'X' to datex(i:1)
+            move function TEST-FORMATTED-DATETIME("YYYYMMDD", datex) to RESULT
+            move i to should_be
+            if result not equal to should_be then
+                display "TEST-FORMATTED-DATETIME("
+                        """YYYYMMDD"""
+                        ", "
+                        function trim(datex)
+                        ") should have been "
+                        should_be " but was " result
+                move 1 to return-code
+                end-if
+            move xone to datex(i:1)
+            end-perform.
+        move "19000229" to datex
+        move function TEST-FORMATTED-DATETIME("YYYYMMDD", datex) to RESULT
+        move 8 to should_be
+        if result not equal to should_be then
+            display "TEST-FORMATTED-DATETIME("
+                    """YYYYMMDD"""
+                    ", "
+                    function trim(datex)
+                    ") should have been "
+                    should_be " but was " result
+            move 1 to return-code
+            end-if.
+        move "20000229" to datex
+        move function TEST-FORMATTED-DATETIME("YYYYMMDD", datex) to RESULT
+        move 0 to should_be
+        if result not equal to should_be then
+            display "TEST-FORMATTED-DATETIME("
+                    """YYYYMMDD"""
+                    ", "
+                    function trim(datex)
+                    ") should have been "
+                    should_be " but was " result
+            move 1 to return-code
+            end-if.
+        move "20007029" to datex
+        move function TEST-FORMATTED-DATETIME("YYYYMMDD", datex) to RESULT
+        move 5 to should_be
+        if result not equal to should_be then
+            display "TEST-FORMATTED-DATETIME("
+                    """YYYYMMDD"""
+                    ", "
+                    function trim(datex)
+                    ") should have been "
+                    should_be " but was " result
+            move 1 to return-code
+            end-if.
+      *>    TESTING YYYY-DDD
+        move "1988" to yyyy of yyyydddv
+        move "000"  to ddd  of yyyydddv
+        move function TEST-FORMATTED-DATETIME("YYYY-DDD", yyyydddv) to RESULT
+        move 8 to should_be
+        if result not equal to should_be then
+            display "TEST-FORMATTED-DATETIME("
+                    """YYYYDDD"""
+                    ", "
+                    function trim(yyyydddv)
+                    ") should have been "
+                    should_be " but was " result
+            move 1 to return-code
+            end-if.
+        move "1988" to yyyy of yyyydddv
+        move "367"  to ddd  of yyyydddv
+        move function TEST-FORMATTED-DATETIME("YYYY-DDD", yyyydddv) to RESULT
+        move 8 to should_be
+        if result not equal to should_be then
+            display "TEST-FORMATTED-DATETIME("
+                    """YYYYDDD"""
+                    ", "
+                    function trim(yyyydddv)
+                    ") should have been "
+                    should_be " but was " result
+            move 1 to return-code
+            end-if.
+        move "1988" to yyyy of yyyydddv
+        move "399"  to ddd  of yyyydddv
+        move function TEST-FORMATTED-DATETIME("YYYY-DDD", yyyydddv) to RESULT
+        move 7 to should_be
+        if result not equal to should_be then
+            display "TEST-FORMATTED-DATETIME("
+                    """YYYYDDD"""
+                    ", "
+                    function trim(yyyydddv)
+                    ") should have been "
+                    should_be " but was " result
+            move 1 to return-code
+            end-if.
+        move 1988 to yyyy of yyyydddv
+        move 400  to ddd  of yyyydddv
+        move function TEST-FORMATTED-DATETIME("YYYY-DDD", yyyydddv) to RESULT
+        move 6 to should_be
+        if result not equal to should_be then
+            display "TEST-FORMATTED-DATETIME("
+                    """YYYYDDD"""
+                    ", "
+                    function trim(yyyydddv)
+                    ") should have been "
+                    should_be " but was " result
+            move 1 to return-code
+            end-if.
+        move 1988 to yyyy of yyyydddv
+        perform varying i from 1 by 1 until i > 366
+            move i to ddd of yyyydddv
+            move function TEST-FORMATTED-DATETIME("YYYY-DDD", yyyydddv) to RESULT
+            move zero to should_be
+            if result not equal to should_be then
+                display "TEST-FORMATTED-DATETIME("
+                        """YYYY-DDD"""
+                        ", "
+                        function trim(yyyydddv)
+                        ") should have been "
+                        should_be " but was " result
+                move 1 to return-code
+                end-if
+            add 1 to date-integer
+            end-perform.
+        end program test.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-FORMATTED-DATETIME_with_dates.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-FORMATTED-DATETIME_with_dates.cob

new file mode 100644 (file)

index 0000000..1b571f9
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-FORMATTED-DATETIME_with_dates.cob
@@ -0,0 +1,118 @@
+       *> { dg-do run }
+
+        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
+            .
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-FORMATTED-DATETIME_with_datetimes.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-FORMATTED-DATETIME_with_datetimes.cob

new file mode 100644 (file)

index 0000000..5591fbb
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-FORMATTED-DATETIME_with_datetimes.cob
@@ -0,0 +1,44 @@
+       *> { dg-do run }
+
+        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
+            .
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-FORMATTED-DATETIME_with_times.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-FORMATTED-DATETIME_with_times.cob

new file mode 100644 (file)

index 0000000..ded9551
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-FORMATTED-DATETIME_with_times.cob
@@ -0,0 +1,72 @@
+       *> { dg-do run }
+
+        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
+            .
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-NUMVAL-C.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-NUMVAL-C.cob

new file mode 100644 (file)

index 0000000..e458f4a
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-NUMVAL-C.cob
@@ -0,0 +1,89 @@
+       *> { dg-do run }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-NUMVAL-F.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-NUMVAL-F.cob

new file mode 100644 (file)

index 0000000..3fcec0e
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-NUMVAL-F.cob
@@ -0,0 +1,89 @@
+       *> { dg-do run }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-NUMVAL.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-NUMVAL.cob

new file mode 100644 (file)

index 0000000..bc38b4e
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-NUMVAL.cob
@@ -0,0 +1,89 @@
+       *> { dg-do run }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_TRIM.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_TRIM.cob

new file mode 100644 (file)

index 0000000..054b14a
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_TRIM.cob
@@ -0,0 +1,15 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/FUNCTION_TRIM.out" }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_TRIM.out b/gcc/testsuite/cobol.dg/group2/FUNCTION_TRIM.out

new file mode 100644 (file)

index 0000000..b0e4a72
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_TRIM.out
@@ -0,0 +1,3 @@
+a#b.c%d+e$
+ a#b.c%d+e$
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_TRIM_with_reference_modding.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_TRIM_with_reference_modding.cob

new file mode 100644 (file)

index 0000000..f14f0fa
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_TRIM_with_reference_modding.cob
@@ -0,0 +1,15 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/FUNCTION_TRIM_with_reference_modding.out" }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_TRIM_with_reference_modding.out b/gcc/testsuite/cobol.dg/group2/FUNCTION_TRIM_with_reference_modding.out

new file mode 100644 (file)

index 0000000..f716581
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_TRIM_with_reference_modding.out
@@ -0,0 +1,3 @@
+#b.
+a#b
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_TRIM_zero_length.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_TRIM_zero_length.cob

new file mode 100644 (file)

index 0000000..d92a490
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_TRIM_zero_length.cob
@@ -0,0 +1,18 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/FUNCTION_TRIM_zero_length.out" }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_TRIM_zero_length.out b/gcc/testsuite/cobol.dg/group2/FUNCTION_TRIM_zero_length.out

new file mode 100644 (file)

index 0000000..9aa7900
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_TRIM_zero_length.out
@@ -0,0 +1,3 @@
+>    <
+><
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_UPPER-CASE.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_UPPER-CASE.cob

new file mode 100644 (file)

index 0000000..9bf6a6b
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_UPPER-CASE.cob
@@ -0,0 +1,16 @@
+       *> { dg-do run }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_UPPER-CASE_with_reference_modding.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_UPPER-CASE_with_reference_modding.cob

new file mode 100644 (file)

index 0000000..2f96446
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_UPPER-CASE_with_reference_modding.cob
@@ -0,0 +1,16 @@
+       *> { dg-do run }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_VARIANCE.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_VARIANCE.cob

new file mode 100644 (file)

index 0000000..0a08f5a
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_VARIANCE.cob
@@ -0,0 +1,15 @@
+       *> { dg-do run }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_WHEN-COMPILED.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_WHEN-COMPILED.cob

new file mode 100644 (file)

index 0000000..d47967b
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_WHEN-COMPILED.cob
@@ -0,0 +1,45 @@
+       *> { dg-do run }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_YEAR-TO-YYYY.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_YEAR-TO-YYYY.cob

new file mode 100644 (file)

index 0000000..ece8151
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_YEAR-TO-YYYY.cob
@@ -0,0 +1,15 @@
+       *> { dg-do run }
+
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_as_CALL_parameter_BY_CONTENT.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_as_CALL_parameter_BY_CONTENT.cob

new file mode 100644 (file)

index 0000000..e25ac8b
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_as_CALL_parameter_BY_CONTENT.cob
@@ -0,0 +1,27 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/FUNCTION_as_CALL_parameter_BY_CONTENT.out" }
+
+       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
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_as_CALL_parameter_BY_CONTENT.out b/gcc/testsuite/cobol.dg/group2/FUNCTION_as_CALL_parameter_BY_CONTENT.out

new file mode 100644 (file)

index 0000000..11f0477
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_as_CALL_parameter_BY_CONTENT.out
@@ -0,0 +1,2 @@
+AbcD
+
diff --git a/gcc/testsuite/cobol.dg/group2/Intrinsics_without_FUNCTION_keyword__2_.cob b/gcc/testsuite/cobol.dg/group2/Intrinsics_without_FUNCTION_keyword__2_.cob

new file mode 100644 (file)

index 0000000..b94adf5
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/Intrinsics_without_FUNCTION_keyword__2_.cob
@@ -0,0 +1,17 @@
+       *> { dg-do run }
+
+       IDENTIFICATION   DIVISION.
+       PROGRAM-ID.      prog.
+       ENVIRONMENT      DIVISION.
+       CONFIGURATION    SECTION.
+       REPOSITORY.
+           FUNCTION     PI
+           FUNCTION     E.
+       DATA             DIVISION.
+       WORKING-STORAGE  SECTION.
+       01  Z            PIC 99V99.
+       PROCEDURE        DIVISION.
+           MOVE PI TO Z.
+           MOVE E TO Z.
+           STOP RUN.
+
diff --git a/gcc/testsuite/cobol.dg/group2/Program-to-program_parameters_and_retvals.cob b/gcc/testsuite/cobol.dg/group2/Program-to-program_parameters_and_retvals.cob

new file mode 100644 (file)

index 0000000..6e0443d
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/Program-to-program_parameters_and_retvals.cob
@@ -0,0 +1,237 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/Program-to-program_parameters_and_retvals.out" }
+        IDENTIFICATION DIVISION.
+        PROGRAM-ID.  prog.
+
+        DATA DIVISION.
+        WORKING-STORAGE SECTION.
+        01  var1        pic 9               VALUE 1.
+        01  var2        BINARY-CHAR         VALUE 22.
+        01  var3        pic s999 COMP-3     VALUE -333.
+        01  var4        pic 9999 BINARY     VALUE 4444.
+        01  var5        pic 99.99           VALUE "12.34".
+        01  var6        pic s999V999 COMP-5 VALUE -123.456.
+        01  var7        float-short         VALUE  1.23E10.
+        01  var8        float-long          VALUE  -1.23E20.
+        01  var9        float-extended      VALUE  1.23E40.
+        01  var64       pic  9(15) VALUE 987654321098765.
+        01  var128      pic s9(30) VALUE -987654321098765432109876543210.
+        01  filler.
+         02 varpd       pic 9(18) comp-5 value 1250999747361.
+         02 varp redefines varpd       pointer.
+        01  varg.
+            02 varg1 pic x(7) VALUE "That's".
+            02 varg2 pic x(5) VALUE "all,"  .
+            02 varg3 pic x(7) VALUE "folks!".
+
+        01  var1r        pic 9               .
+        01  var2r        BINARY-CHAR         .
+        01  var3r        pic s999 COMP-3     .
+        01  var4r        pic 9999 BINARY     .
+        01  var5r        pic 99.99           .
+        01  var6r        pic s999V999 COMP-5 .
+        01  var7r        float-short         .
+        01  var8r        float-long          .
+        01  var9r        float-extended      .
+        01  var64r       pic  9(15)          .
+        01  var128r      pic s9(30)          .
+        01  varpr        pointer.
+        01  vargr.
+            02 varg1 pic x(7).
+            02 varg2 pic x(5).
+            02 varg3 pic x(7).
+
+        PROCEDURE DIVISION.
+            display     var1
+            call     "rvar1" USING by value var1 RETURNING var1r
+            display     var1r
+
+            display     var2
+            call     "rvar2" USING by reference var2 RETURNING var2r
+            display     var2r
+
+            display     var3
+            call     "rvar3" USING by content var3 RETURNING var3r
+            display     var3r
+
+            display     var4
+            call     "rvar4" USING by value var4 RETURNING var4r
+            display     var4r
+
+            display     var5
+            call     "rvar5" USING by reference var5 RETURNING var5r
+            display     var5r
+
+            display     var6
+            call     "rvar6" USING by content var6 RETURNING var6r
+            display     var6r
+
+            display     var7
+            call     "rvar7" USING by reference var7 RETURNING var7r
+            display     var7r
+
+            display     var8
+            call     "rvar8" USING by value var8 RETURNING var8r
+            display     var8r
+
+            display     var9
+            call     "rvar9" USING by content var9 RETURNING var9r
+            display     var9r
+
+            display     var64
+            call     "rvar64" USING by value var64 RETURNING var64r
+            display     var64r
+
+            display     var128
+            call     "rvar128" USING by reference var128 RETURNING var128r
+            display     var128r
+
+            display     varp
+            call     "rvarp" USING by reference varp RETURNING varpr
+            display     varpr
+
+            display     """"varg""""
+            call     "rvarg" USING by reference varg RETURNING vargr
+            display     """"vargr""""
+
+            GOBACK.
+            END PROGRAM prog.
+
+
+        IDENTIFICATION DIVISION.
+        PROGRAM-ID. rvar1.
+        DATA DIVISION.
+        LINKAGE SECTION.
+        01  var         pic 9               .
+        01  varr        pic 9               .
+        PROCEDURE DIVISION USING by value var RETURNING varr.
+            MOVE var TO varr.
+            END PROGRAM rvar1.
+
+        IDENTIFICATION DIVISION.
+        PROGRAM-ID. rvar2.
+        DATA DIVISION.
+        LINKAGE SECTION.
+        01  var         BINARY-CHAR         .
+        01  varr        BINARY-CHAR         .
+        PROCEDURE DIVISION USING by reference var RETURNING varr.
+            MOVE var TO varr.
+            END PROGRAM rvar2.
+
+        IDENTIFICATION DIVISION.
+        PROGRAM-ID. rvar3.
+        DATA DIVISION.
+        LINKAGE SECTION.
+        01  var         pic s999 COMP-3     .
+        01  varr        pic s999 COMP-3     .
+        PROCEDURE DIVISION USING by reference var RETURNING varr.
+            MOVE var TO varr.
+            END PROGRAM rvar3.
+
+        IDENTIFICATION DIVISION.
+        PROGRAM-ID. rvar4.
+        DATA DIVISION.
+        LINKAGE SECTION.
+        01  var         pic 9999 BINARY     .
+        01  varr        pic 9999 BINARY     .
+        PROCEDURE DIVISION USING by value var RETURNING varr.
+            MOVE var TO varr.
+            END PROGRAM rvar4.
+
+        IDENTIFICATION DIVISION.
+        PROGRAM-ID. rvar5.
+        DATA DIVISION.
+        LINKAGE SECTION.
+        01  var         pic 99.99           .
+        01  varr        pic 99.99           .
+        PROCEDURE DIVISION USING by reference var RETURNING varr.
+            MOVE var TO varr.
+            END PROGRAM rvar5.
+
+        IDENTIFICATION DIVISION.
+        PROGRAM-ID. rvar6.
+        DATA DIVISION.
+        LINKAGE SECTION.
+        01  var         pic s999V999 COMP-5 .
+        01  varr        pic s999V999 COMP-5 .
+        PROCEDURE DIVISION USING reference var RETURNING varr.
+            MOVE var TO varr.
+            END PROGRAM rvar6.
+
+        IDENTIFICATION DIVISION.
+        PROGRAM-ID. rvar7.
+        DATA DIVISION.
+        LINKAGE SECTION.
+        01  var         float-short          .
+        01  varr        float-short          .
+        PROCEDURE DIVISION USING by reference VAR RETURNING varr.
+            MOVE var TO varr.
+            GOBACK.
+            END PROGRAM rvar7.
+
+        IDENTIFICATION DIVISION.
+        PROGRAM-ID. rvar8.
+        DATA DIVISION.
+        LINKAGE SECTION.
+        01  var         float-long          .
+        01  varr        float-long          .
+        PROCEDURE DIVISION USING by value var RETURNING varr.
+            MOVE var TO varr.
+            END PROGRAM rvar8.
+
+        IDENTIFICATION DIVISION.
+        PROGRAM-ID. rvar9.
+        DATA DIVISION.
+        LINKAGE SECTION.
+        01  var         float-extended      .
+        01  varr        float-extended      .
+        PROCEDURE DIVISION USING by reference var RETURNING varr.
+            MOVE var TO varr.
+            END PROGRAM rvar9.
+
+        IDENTIFICATION DIVISION.
+        PROGRAM-ID. rvar64.
+        DATA DIVISION.
+        LINKAGE SECTION.
+        01  var        pic  9(15)          .
+        01  varr       pic  9(15)          .
+        PROCEDURE DIVISION USING by value var RETURNING varr.
+            MOVE var TO varr.
+            END PROGRAM rvar64.
+
+        IDENTIFICATION DIVISION.
+        PROGRAM-ID. rvar128.
+        DATA DIVISION.
+        LINKAGE SECTION.
+        01  var  pic s9(30) .
+        01  varr pic s9(30) .
+        PROCEDURE DIVISION USING by reference var RETURNING varr.
+            MOVE var TO varr.
+            END PROGRAM rvar128.
+
+        IDENTIFICATION DIVISION.
+        PROGRAM-ID. rvarp.
+        DATA DIVISION.
+        LINKAGE SECTION.
+        01  var  pointer .
+        01  varr pointer .
+        PROCEDURE DIVISION USING by reference var RETURNING varr.
+            SET varr TO var.
+            END PROGRAM rvarp.
+
+        IDENTIFICATION DIVISION.
+        PROGRAM-ID. rvarg.
+        DATA DIVISION.
+        LINKAGE SECTION.
+        01  var.
+            02 varg1 pic x(7).
+            02 varg2 pic x(5).
+            02 varg3 pic x(7).
+        01  varr.
+            02 varg1 pic x(7).
+            02 varg2 pic x(5).
+            02 varg3 pic x(7).
+        PROCEDURE DIVISION USING by reference var RETURNING varr.
+            MOVE var TO varr.
+            END PROGRAM rvarg.
+
diff --git a/gcc/testsuite/cobol.dg/group2/Program-to-program_parameters_and_retvals.out b/gcc/testsuite/cobol.dg/group2/Program-to-program_parameters_and_retvals.out

new file mode 100644 (file)

index 0000000..ce543df
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/Program-to-program_parameters_and_retvals.out
@@ -0,0 +1,27 @@
+1
+1
++022
++022
+-333
+-333
+4444
+4444
+12.34
+12.34
+-123.456
+-123.456
+1.230000026E+10
+1.230000026E+10
+-1.23E+20
+-1.23E+20
+1.23E+40
+1.23E+40
+987654321098765
+987654321098765
+-987654321098765432109876543210
+-987654321098765432109876543210
+0x0000012345654321
+0x0000012345654321
+"That's all, folks! "
+"That's all, folks! "
+
diff --git a/gcc/testsuite/cobol.dg/group2/Recursive_FUNCTION_with_local-storage.cob b/gcc/testsuite/cobol.dg/group2/Recursive_FUNCTION_with_local-storage.cob

new file mode 100644 (file)

index 0000000..122aab7
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/Recursive_FUNCTION_with_local-storage.cob
@@ -0,0 +1,38 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/Recursive_FUNCTION_with_local-storage.out" }
+        IDENTIFICATION   DIVISION.
+        FUNCTION-ID.      callee.
+        DATA             DIVISION.
+        LOCAL-STORAGE    SECTION.
+        01 LCL-X         PIC 999 .
+        LINKAGE          SECTION.
+        01 parm          PIC 999.
+        01 retval        PIC 999.
+        PROCEDURE        DIVISION USING parm RETURNING retval.
+            display "On entry, parm is: " parm
+            move parm to lcl-x
+            move parm to retval
+            subtract 1 from parm
+            if parm > 0
+                display "A The function returns " function callee(parm).
+            if lcl-x not equal to retval
+                display "On exit, lcl-s and retval are: " lcl-x " and " retval
+                display "But they should be equal to each other"
+                end-if
+            goback.
+            end function callee.
+        IDENTIFICATION   DIVISION.
+        PROGRAM-ID.      caller.
+        ENVIRONMENT      DIVISION.
+        CONFIGURATION    SECTION.
+        REPOSITORY.
+                         FUNCTION callee.
+        DATA             DIVISION.
+        WORKING-STORAGE  SECTION.
+        01 val           PIC 999 VALUE 5.
+        PROCEDURE        DIVISION.
+           DISPLAY "Starting value is: " val
+           display "B The function returns " function callee(val).
+           STOP RUN.
+           end program caller.
+
diff --git a/gcc/testsuite/cobol.dg/group2/Recursive_FUNCTION_with_local-storage.out b/gcc/testsuite/cobol.dg/group2/Recursive_FUNCTION_with_local-storage.out

new file mode 100644 (file)

index 0000000..3ccd69a
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/Recursive_FUNCTION_with_local-storage.out
@@ -0,0 +1,12 @@
+Starting value is: 005
+On entry, parm is: 005
+On entry, parm is: 004
+On entry, parm is: 003
+On entry, parm is: 002
+On entry, parm is: 001
+A The function returns 001
+A The function returns 002
+A The function returns 003
+A The function returns 004
+B The function returns 005
+
diff --git a/gcc/testsuite/cobol.dg/group2/Repository_functions_clause.cob b/gcc/testsuite/cobol.dg/group2/Repository_functions_clause.cob

new file mode 100644 (file)

index 0000000..cc306b4
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/Repository_functions_clause.cob
@@ -0,0 +1,14 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/Repository_functions_clause.out" }
+
+       IDENTIFICATION DIVISION.
+       PROGRAM-ID. prog.
+       ENVIRONMENT DIVISION.
+       CONFIGURATION SECTION.
+          SOURCE-COMPUTER. a.
+          OBJECT-COMPUTER. a.
+          REPOSITORY.
+             FUNCTION ALL INTRINSIC.
+       PROCEDURE DIVISION.
+          DISPLAY "OK".
+
diff --git a/gcc/testsuite/cobol.dg/group2/Repository_functions_clause.out b/gcc/testsuite/cobol.dg/group2/Repository_functions_clause.out

new file mode 100644 (file)

index 0000000..885fd66
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/Repository_functions_clause.out
@@ -0,0 +1,2 @@
+OK
+
diff --git a/gcc/testsuite/cobol.dg/group2/UDF_RETURNING_group_and_PIC_9_5_.cob b/gcc/testsuite/cobol.dg/group2/UDF_RETURNING_group_and_PIC_9_5_.cob

new file mode 100644 (file)

index 0000000..d4df058
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/UDF_RETURNING_group_and_PIC_9_5_.cob
@@ -0,0 +1,51 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/UDF_RETURNING_group_and_PIC_9_5_.out" }
+
+       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, COPYPAR2.
+       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.
+
diff --git a/gcc/testsuite/cobol.dg/group2/UDF_RETURNING_group_and_PIC_9_5_.out b/gcc/testsuite/cobol.dg/group2/UDF_RETURNING_group_and_PIC_9_5_.out

new file mode 100644 (file)

index 0000000..1361e9a
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/UDF_RETURNING_group_and_PIC_9_5_.out
@@ -0,0 +1,5 @@
+"Santa                           Claus                           "
+"Santa                           Claus                           "
+54321
+54321
+
diff --git a/gcc/testsuite/cobol.dg/group2/UDF_fibonacci_recursion.cob b/gcc/testsuite/cobol.dg/group2/UDF_fibonacci_recursion.cob

new file mode 100644 (file)

index 0000000..71ef09b
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/UDF_fibonacci_recursion.cob
@@ -0,0 +1,39 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/UDF_fibonacci_recursion.out" }
+
+        identification division.
+        function-id. fib-func.
+        data division.
+        working-storage section.
+        01 instance pic 9999 value 0.
+        linkage section.
+        01 n binary-char unsigned.
+        01 f-n binary-long unsigned.
+        procedure division using n returning f-n.
+           evaluate true
+           when n = 0
+                move 0 to f-n
+           when n = 1
+                move 1 to f-n
+           when other
+                compute f-n =  fib-func(n - 1) + fib-func(n - 2)
+           end-evaluate
+           goback .
+        end function fib-func.
+
+        identification division.
+        program-id. pmain.
+        environment division.
+        configuration section.
+        repository.
+           function fib-func.
+        data division.
+        working-storage section.
+        01 n binary-char unsigned.
+        procedure division.
+           perform varying n from 1 by 1 until n > 16
+                display "fibonacci(" n "): " fib-func(n)
+           end-perform
+           stop run.
+        end program pmain.
+
diff --git a/gcc/testsuite/cobol.dg/group2/UDF_fibonacci_recursion.out b/gcc/testsuite/cobol.dg/group2/UDF_fibonacci_recursion.out

new file mode 100644 (file)

index 0000000..34dabfb
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/UDF_fibonacci_recursion.out
@@ -0,0 +1,17 @@
+fibonacci(001): 1
+fibonacci(002): 1
+fibonacci(003): 2
+fibonacci(004): 3
+fibonacci(005): 5
+fibonacci(006): 8
+fibonacci(007): 13
+fibonacci(008): 21
+fibonacci(009): 34
+fibonacci(010): 55
+fibonacci(011): 89
+fibonacci(012): 144
+fibonacci(013): 233
+fibonacci(014): 377
+fibonacci(015): 610
+fibonacci(016): 987
+
diff --git a/gcc/testsuite/cobol.dg/group2/UDF_in_COMPUTE.cob b/gcc/testsuite/cobol.dg/group2/UDF_in_COMPUTE.cob

new file mode 100644 (file)

index 0000000..74576b6
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/UDF_in_COMPUTE.cob
@@ -0,0 +1,33 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/UDF_in_COMPUTE.out" }
+
+       IDENTIFICATION DIVISION.
+       FUNCTION-ID. func.
+
+       DATA DIVISION.
+       LINKAGE SECTION.
+       01  num PIC 999.
+
+       PROCEDURE DIVISION RETURNING num.
+           MOVE 100 TO num
+           .
+       END FUNCTION func.
+
+       IDENTIFICATION DIVISION.
+       PROGRAM-ID. prog.
+
+       ENVIRONMENT DIVISION.
+       CONFIGURATION SECTION.
+       REPOSITORY.
+           FUNCTION func.
+
+       DATA DIVISION.
+       WORKING-STORAGE SECTION.
+       01  x PIC 999.
+
+       PROCEDURE DIVISION.
+           COMPUTE x = 101 + FUNCTION func
+           DISPLAY x
+           .
+       END PROGRAM prog.
+
diff --git a/gcc/testsuite/cobol.dg/group2/UDF_in_COMPUTE.out b/gcc/testsuite/cobol.dg/group2/UDF_in_COMPUTE.out

new file mode 100644 (file)

index 0000000..d757a46
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/UDF_in_COMPUTE.out
@@ -0,0 +1,2 @@
+201
+
diff --git a/gcc/testsuite/cobol.dg/group2/UDF_with_recursion.cob b/gcc/testsuite/cobol.dg/group2/UDF_with_recursion.cob

new file mode 100644 (file)

index 0000000..1e9b378
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/UDF_with_recursion.cob
@@ -0,0 +1,49 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/UDF_with_recursion.out" }
+
+       IDENTIFICATION DIVISION.
+       FUNCTION-ID. foo.
+
+       DATA DIVISION.
+       WORKING-STORAGE SECTION.
+       01  ttl  PIC 9 VALUE 1.
+
+       LOCAL-STORAGE SECTION.
+       01  num  PIC 9.
+
+       LINKAGE SECTION.
+       01  arg PIC 9.
+       01  ret PIC 9.
+
+       PROCEDURE DIVISION USING arg RETURNING ret.
+           IF arg < 5
+              ADD 1 TO arg GIVING num END-ADD
+              MOVE FUNCTION foo (num) TO ret
+           ELSE
+              MOVE arg TO ret
+           END-IF
+           DISPLAY "Step: " ttl ", Arg: " arg ", Return: " ret
+           END-DISPLAY
+           ADD 1 to ttl END-ADD
+           GOBACK.
+       END FUNCTION foo.
+
+       IDENTIFICATION DIVISION.
+       PROGRAM-ID. prog.
+
+       ENVIRONMENT DIVISION.
+       CONFIGURATION SECTION.
+       REPOSITORY.
+           FUNCTION foo.
+
+       DATA DIVISION.
+       WORKING-STORAGE SECTION.
+       01 num PIC 9 VALUE 1.
+
+       PROCEDURE DIVISION.
+           DISPLAY "Return value '" FUNCTION foo (num) "'"
+             WITH NO ADVANCING
+           END-DISPLAY
+           GOBACK.
+       END PROGRAM prog.
+
diff --git a/gcc/testsuite/cobol.dg/group2/UDF_with_recursion.out b/gcc/testsuite/cobol.dg/group2/UDF_with_recursion.out

new file mode 100644 (file)

index 0000000..13bd1e9
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/UDF_with_recursion.out
@@ -0,0 +1,6 @@
+Step: 1, Arg: 5, Return: 5
+Step: 2, Arg: 4, Return: 5
+Step: 3, Arg: 3, Return: 5
+Step: 4, Arg: 2, Return: 5
+Step: 5, Arg: 1, Return: 5
+Return value '5'
diff --git a/gcc/testsuite/cobol.dg/group2/call_subprogram_using_pointer__passing_pointer.cob b/gcc/testsuite/cobol.dg/group2/call_subprogram_using_pointer__passing_pointer.cob

new file mode 100644 (file)

index 0000000..3753e7a
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/call_subprogram_using_pointer__passing_pointer.cob
@@ -0,0 +1,36 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/call_subprogram_using_pointer__passing_pointer.out" }
+
+       IDENTIFICATION DIVISION.
+       PROGRAM-ID. prog.
+       DATA DIVISION.
+       WORKING-STORAGE SECTION.
+       77 varp program-pointer.
+       PROCEDURE DIVISION.
+          SET varp TO ENTRY "ref".
+          CALL "sub" USING BY VALUE varp.
+       end program prog.
+
+       IDENTIFICATION DIVISION.
+       PROGRAM-ID. sub.
+       DATA DIVISION.
+       WORKING-STORAGE SECTION.
+       77 param pic x(12) value "hi".
+       LINKAGE SECTION.
+       77 varp program-pointer.
+       PROCEDURE DIVISION USING BY VALUE varp.
+          DISPLAY "About to call 'ref hi' directly"
+          CALL "ref" USING param.
+          DISPLAY "About to call 'ref hi' indirectly"
+          CALL varp USING param.
+       end program sub.
+
+       IDENTIFICATION DIVISION.
+       PROGRAM-ID. ref.
+       DATA DIVISION.
+       LINKAGE SECTION.
+       77 greeting pic x(12).
+       PROCEDURE DIVISION using greeting.
+          DISPLAY """" greeting """".
+       end program ref.
+
diff --git a/gcc/testsuite/cobol.dg/group2/call_subprogram_using_pointer__passing_pointer.out b/gcc/testsuite/cobol.dg/group2/call_subprogram_using_pointer__passing_pointer.out

new file mode 100644 (file)

index 0000000..7a12ec1
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/call_subprogram_using_pointer__passing_pointer.out
@@ -0,0 +1,5 @@
+About to call 'ref hi' directly
+"hi          "
+About to call 'ref hi' indirectly
+"hi          "
+
author	Bob Dubner <rdubner@symas.com>
	Fri, 4 Apr 2025 18:41:27 +0000 (14:41 -0400)
committer	Robert Dubner <rdubner@symas.com>
	Fri, 4 Apr 2025 20:04:01 +0000 (16:04 -0400)
gcc/testsuite/cobol.dg/group2/FUNCTION_ABS.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_ABS.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_ACOS.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_ALL_INTRINSIC_simple_test.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_ALL_INTRINSIC_simple_test.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_ANNUITY.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_ASIN.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_ATAN.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_BIGGER-POINTER.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_BIGGER-POINTER.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_BIGGER-POINTER__2_.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_BIGGER-POINTER__2_.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_BYTE-LENGTH.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_BYTE-LENGTH.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_CHAR.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_COMBINED-DATETIME.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_CONCAT___CONCATENATE.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_CONCAT_with_reference_modding.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_COS.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_CURRENT-DATE.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_DATE-OF-INTEGER.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_DATE-TO-YYYYMMDD.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_DATE___TIME_OMNIBUS.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_DAY-OF-INTEGER.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_DAY-TO-YYYYDDD.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_E.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_EXCEPTION-FILE.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_EXCEPTION-FILE.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_EXCEPTION-STATEMENT.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_EXCEPTION-STATEMENT.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_EXCEPTION-STATUS.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_EXCEPTION-STATUS.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_EXP.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_EXP10.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_FACTORIAL.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_FORMATTED-DATE.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_FORMATTED-DATETIME.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_FORMATTED-DATETIME_with_ref_modding.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_FORMATTED-DATE_TIME_DATETIME.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_FORMATTED-DATE_TIME_DATETIME.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_FORMATTED-DATE_with_ref_modding.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_FORMATTED-TIME_DP.COMMA.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_FORMATTED-TIME_with_ref_modding.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_FRACTION-PART.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_HEX-OF.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_HEX-OF.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_HIGHEST-ALGEBRAIC.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_INTEGER-OF-DATE.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_INTEGER-OF-DAY.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_INTEGER-OF-FORMATTED-DATE.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_INTEGER-PART.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_INTEGER.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_LENGTH__1_.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_LENGTH__2_.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_LENGTH__2_.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_LOCALE-COMPARE.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_LOCALE-DATE.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_LOCALE-DATE.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_LOCALE-TIME-FROM-SECONDS.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_LOCALE-TIME-FROM-SECONDS.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_LOCALE-TIME.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_LOCALE-TIME.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_LOG.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_LOG10.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_LOWER-CASE.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_LOWER-CASE_with_reference_modding.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_LOWEST-ALGEBRAIC.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_MAX.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_MAX.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_MEAN.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_MEAN.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_MEDIAN.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_MEDIAN.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_MIDRANGE.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_MIDRANGE.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_MIN.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_MIN.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_MODULE-NAME.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_MODULE-NAME.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_MOD__invalid_.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_MOD__valid_.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_NUMVAL-C.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_NUMVAL-C_DP.COMMA.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_NUMVAL-F.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_NUMVAL-F.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_NUMVAL.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_ORD-MAX.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_ORD-MAX.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_ORD-MIN.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_ORD-MIN.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_ORD.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_ORD.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_PI.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_PRESENT-VALUE.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_PRESENT-VALUE.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_RANDOM.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_RANGE.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_REM__invalid_.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_REM__valid_.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_REVERSE.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_REVERSE_with_reference_modding.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_SECONDS-FROM-FORMATTED-TIME.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_SECONDS-PAST-MIDNIGHT.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_SIGN.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_SIN.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_SQRT.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_STANDARD-DEVIATION.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_SUBSTITUTE-CASE.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_SUBSTITUTE-CASE_with_reference_mod.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_SUBSTITUTE.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_SUBSTITUTE.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_SUBSTITUTE_with_reference_modding.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_SUM.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_TAN.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-DATE-YYYYMMDD.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-DATE-YYYYMMDD.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-DAY-YYYYDDD__1_.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-DAY-YYYYDDD__1_.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-DAY-YYYYDDD__2_.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-FORMATTED-DATETIME_DP.COMMA.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-FORMATTED-DATETIME_additional.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-FORMATTED-DATETIME_with_dates.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-FORMATTED-DATETIME_with_datetimes.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-FORMATTED-DATETIME_with_times.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-NUMVAL-C.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-NUMVAL-F.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_TEST-NUMVAL.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_TRIM.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_TRIM.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_TRIM_with_reference_modding.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_TRIM_with_reference_modding.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_TRIM_zero_length.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_TRIM_zero_length.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_UPPER-CASE.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_UPPER-CASE_with_reference_modding.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_VARIANCE.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_WHEN-COMPILED.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_YEAR-TO-YYYY.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_as_CALL_parameter_BY_CONTENT.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FUNCTION_as_CALL_parameter_BY_CONTENT.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/Intrinsics_without_FUNCTION_keyword__2_.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/Program-to-program_parameters_and_retvals.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/Program-to-program_parameters_and_retvals.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/Recursive_FUNCTION_with_local-storage.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/Recursive_FUNCTION_with_local-storage.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/Repository_functions_clause.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/Repository_functions_clause.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/UDF_RETURNING_group_and_PIC_9_5_.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/UDF_RETURNING_group_and_PIC_9_5_.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/UDF_fibonacci_recursion.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/UDF_fibonacci_recursion.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/UDF_in_COMPUTE.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/UDF_in_COMPUTE.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/UDF_with_recursion.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/UDF_with_recursion.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/call_subprogram_using_pointer__passing_pointer.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/call_subprogram_using_pointer__passing_pointer.out	[new file with mode: 0644]	patch \| blob