Add Fortran tests for named constants in data and firstprivate clauses

Tests/acc_named_constant_data_firstprivate.F90

@@ -0,0 +1,338 @@
+! acc_named_constant_data_firstprivate.F90
+!
+! Feature under test (OpenACC 3.4, Section 1.6, Feb 2026):
+! - A Fortran named constant (PARAMETER) is a valid "var" and is allowed
+!   in data clauses and firstprivate clauses.
+!
+! Notes:
+!  T1: A Fortran INTEGER PARAMETER can appear in a firstprivate clause.
+!  T2: A Fortran REAL PARAMETER can appear in a firstprivate clause.
+!  T3: A Fortran PARAMETER can appear in a data clause (copyin).
+!  T4: A PARAMETER array can appear in a firstprivate clause.
+!  T5: A PARAMETER array can appear in a data clause (copyin).
+!  T6: A PARAMETER can appear in a create clause.
+!  T7: A PARAMETER can appear in present_or_copyin.
+!
+
+
+#ifndef T1
+!T1:syntax,firstprivate,runtime,compute,V:3.4-
+! firstprivate with INTEGER named constant
+      LOGICAL FUNCTION test1()
+        IMPLICIT NONE
+        INCLUDE "acc_testsuite.Fh"
+        INTEGER :: i, errors
+        REAL(8), DIMENSION(LOOPCOUNT) :: a, c
+        INTEGER, PARAMETER :: K = 7
+
+        errors = 0
+        CALL RANDOM_NUMBER(a)
+        c = 0.0D0
+
+        !$acc data copyin(a(1:LOOPCOUNT)) copy(c(1:LOOPCOUNT))
+          !$acc parallel loop present(a(1:LOOPCOUNT), c(1:LOOPCOUNT)) firstprivate(K)
+          DO i = 1, LOOPCOUNT
+            c(i) = a(i) + DBLE(K)
+          END DO
+          !$acc end parallel loop
+        !$acc end data
+
+        DO i = 1, LOOPCOUNT
+          IF (ABS(c(i) - (a(i) + DBLE(K))) .GT. PRECISION) THEN
+            errors = errors + 1
+          END IF
+        END DO
+
+        test1 = (errors .NE. 0)
+      END FUNCTION
+#endif
+
+#ifndef T2
+!T2:syntax,firstprivate,runtime,compute,V:3.4-
+! firstprivate with REAL named constant
+      LOGICAL FUNCTION test2()
+        IMPLICIT NONE
+        INCLUDE "acc_testsuite.Fh"
+        INTEGER :: i, errors
+        REAL(8), DIMENSION(LOOPCOUNT) :: a, c
+        REAL(8), PARAMETER :: ALPHA = 2.5D0
+
+        errors = 0
+        CALL RANDOM_NUMBER(a)
+        c = 0.0D0
+
+        !$acc data copyin(a(1:LOOPCOUNT)) copy(c(1:LOOPCOUNT))
+          !$acc parallel loop present(a(1:LOOPCOUNT), c(1:LOOPCOUNT)) firstprivate(ALPHA)
+          DO i = 1, LOOPCOUNT
+            c(i) = ALPHA * a(i)
+          END DO
+          !$acc end parallel loop
+        !$acc end data
+
+        DO i = 1, LOOPCOUNT
+          IF (ABS(c(i) - (ALPHA * a(i))) .GT. PRECISION) THEN
+            errors = errors + 1
+          END IF
+        END DO
+
+        test2 = (errors .NE. 0)
+      END FUNCTION
+#endif
+
+#ifndef T3
+!T3:syntax,data-clause,runtime,compute,V:3.4-
+! named constant appears in a DATA clause (copyin) and is used on device
+! (no firstprivate here on purpose)
+      LOGICAL FUNCTION test3()
+        IMPLICIT NONE
+        INCLUDE "acc_testsuite.Fh"
+        INTEGER :: i, errors
+        REAL(8), DIMENSION(LOOPCOUNT) :: a, c
+        INTEGER, PARAMETER :: SHIFT = 3
+
+        errors = 0
+        CALL RANDOM_NUMBER(a)
+        c = 0.0D0
+
+        !$acc data copyin(a(1:LOOPCOUNT), SHIFT) copy(c(1:LOOPCOUNT))
+          !$acc parallel loop present(a(1:LOOPCOUNT), c(1:LOOPCOUNT))
+          DO i = 1, LOOPCOUNT
+            c(i) = a(i) + DBLE(SHIFT)
+          END DO
+          !$acc end parallel loop
+        !$acc end data
+
+        DO i = 1, LOOPCOUNT
+          IF (ABS(c(i) - (a(i) + DBLE(SHIFT))) .GT. PRECISION) THEN
+            errors = errors + 1
+          END IF
+        END DO
+
+        test3 = (errors .NE. 0)
+      END FUNCTION
+#endif
+
+#ifndef T4
+!T4:syntax,firstprivate,runtime,compute,V:3.4-
+! firstprivate with a named-constant ARRAY
+      LOGICAL FUNCTION test4()
+        IMPLICIT NONE
+        INCLUDE "acc_testsuite.Fh"
+        INTEGER :: i, errors
+        REAL(8), DIMENSION(LOOPCOUNT) :: a, c
+        REAL(8), PARAMETER :: W(2) = (/ 1.25D0, 0.75D0 /)
+
+        errors = 0
+        CALL RANDOM_NUMBER(a)
+        c = 0.0D0
+
+        !$acc data copyin(a(1:LOOPCOUNT)) copy(c(1:LOOPCOUNT))
+          !$acc parallel loop present(a(1:LOOPCOUNT), c(1:LOOPCOUNT)) firstprivate(W)
+          DO i = 1, LOOPCOUNT
+            c(i) = W(1) * a(i) + W(2)
+          END DO
+          !$acc end parallel loop
+        !$acc end data
+
+        DO i = 1, LOOPCOUNT
+          IF (ABS(c(i) - (W(1) * a(i) + W(2))) .GT. PRECISION) THEN
+            errors = errors + 1
+          END IF
+        END DO
+
+        test4 = (errors .NE. 0)
+      END FUNCTION
+#endif
+
+#ifndef T5
+!T5:syntax,data-clause,runtime,compute,V:3.4-
+! named-constant ARRAY appears in a DATA clause (copyin) and is used on device
+! (no firstprivate here on purpose)
+      LOGICAL FUNCTION test5()
+        IMPLICIT NONE
+        INCLUDE "acc_testsuite.Fh"
+        INTEGER :: i, errors
+        REAL(8), DIMENSION(LOOPCOUNT) :: a, c
+        REAL(8), PARAMETER :: BIAS(2) = (/ 0.5D0, 2.0D0 /)
+
+        errors = 0
+        CALL RANDOM_NUMBER(a)
+        c = 0.0D0
+
+        !$acc data copyin(a(1:LOOPCOUNT), BIAS) copy(c(1:LOOPCOUNT))
+          !$acc parallel loop present(a(1:LOOPCOUNT), c(1:LOOPCOUNT))
+          DO i = 1, LOOPCOUNT
+            c(i) = BIAS(2) * a(i) + BIAS(1)
+          END DO
+          !$acc end parallel loop
+        !$acc end data
+
+        DO i = 1, LOOPCOUNT
+          IF (ABS(c(i) - (BIAS(2) * a(i) + BIAS(1))) .GT. PRECISION) THEN
+            errors = errors + 1
+          END IF
+        END DO
+
+        test5 = (errors .NE. 0)
+      END FUNCTION
+#endif
+
+#ifndef T6
+!T6:syntax,data-clause,runtime,compute,V:3.4-
+! named constant in CREATE clause (device allocation only); used on device (read-only)
+      LOGICAL FUNCTION test6()
+        IMPLICIT NONE
+        INCLUDE "acc_testsuite.Fh"
+        INTEGER :: i, errors
+        REAL(8), DIMENSION(LOOPCOUNT) :: a, c
+        INTEGER, PARAMETER :: MULT = 4
+
+        errors = 0
+        CALL RANDOM_NUMBER(a)
+        c = 0.0D0
+
+        !$acc data copyin(a(1:LOOPCOUNT)) create(MULT) copy(c(1:LOOPCOUNT))
+          !$acc parallel loop present(a(1:LOOPCOUNT), c(1:LOOPCOUNT))
+          DO i = 1, LOOPCOUNT
+            c(i) = DBLE(MULT) * a(i)
+          END DO
+          !$acc end parallel loop
+        !$acc end data
+
+        DO i = 1, LOOPCOUNT
+          IF (ABS(c(i) - (DBLE(MULT) * a(i))) .GT. PRECISION) THEN
+            errors = errors + 1
+          END IF
+        END DO
+
+        test6 = (errors .NE. 0)
+      END FUNCTION
+#endif
+
+#ifndef T7
+!T7:syntax,data-clause,runtime,compute,V:3.4-
+! named constant in PRESENT_OR_COPYIN data clause; used on device (read-only)
+      LOGICAL FUNCTION test7()
+        IMPLICIT NONE
+        INCLUDE "acc_testsuite.Fh"
+        INTEGER :: i, errors
+        REAL(8), DIMENSION(LOOPCOUNT) :: a, c
+        INTEGER, PARAMETER :: OFF = 9
+
+        errors = 0
+        CALL RANDOM_NUMBER(a)
+        c = 0.0D0
+
+        !$acc data copyin(a(1:LOOPCOUNT)) present_or_copyin(OFF) copy(c(1:LOOPCOUNT))
+          !$acc parallel loop present(a(1:LOOPCOUNT), c(1:LOOPCOUNT))
+          DO i = 1, LOOPCOUNT
+            c(i) = a(i) + DBLE(OFF)
+          END DO
+          !$acc end parallel loop
+        !$acc end data
+
+        DO i = 1, LOOPCOUNT
+          IF (ABS(c(i) - (a(i) + DBLE(OFF))) .GT. PRECISION) THEN
+            errors = errors + 1
+          END IF
+        END DO
+
+        test7 = (errors .NE. 0)
+      END FUNCTION
+#endif
+
+      PROGRAM main
+        IMPLICIT NONE
+        INCLUDE "acc_testsuite.Fh"
+        INTEGER :: failcode, testrun
+        LOGICAL :: failed
+#ifndef T1
+        LOGICAL :: test1
+#endif
+#ifndef T2
+        LOGICAL :: test2
+#endif
+#ifndef T3
+        LOGICAL :: test3
+#endif
+#ifndef T4
+        LOGICAL :: test4
+#endif
+#ifndef T5
+        LOGICAL :: test5
+#endif
+#ifndef T6
+        LOGICAL :: test6
+#endif
+#ifndef T7
+        LOGICAL :: test7
+#endif
+
+        failcode = 0
+
+#ifndef T1
+        failed = .FALSE.
+        DO testrun = 1, NUM_TEST_CALLS
+          failed = failed .OR. test1()
+        END DO
+        IF (failed) THEN
+          failcode = failcode + 2**0
+        END IF
+#endif
+#ifndef T2
+        failed = .FALSE.
+        DO testrun = 1, NUM_TEST_CALLS
+          failed = failed .OR. test2()
+        END DO
+        IF (failed) THEN
+          failcode = failcode + 2**1
+        END IF
+#endif
+#ifndef T3
+        failed = .FALSE.
+        DO testrun = 1, NUM_TEST_CALLS
+          failed = failed .OR. test3()
+        END DO
+        IF (failed) THEN
+          failcode = failcode + 2**2
+        END IF
+#endif
+#ifndef T4
+        failed = .FALSE.
+        DO testrun = 1, NUM_TEST_CALLS
+          failed = failed .OR. test4()
+        END DO
+        IF (failed) THEN
+          failcode = failcode + 2**3
+        END IF
+#endif
+#ifndef T5
+        failed = .FALSE.
+        DO testrun = 1, NUM_TEST_CALLS
+          failed = failed .OR. test5()
+        END DO
+        IF (failed) THEN
+          failcode = failcode + 2**4
+        END IF
+#endif
+#ifndef T6
+        failed = .FALSE.
+        DO testrun = 1, NUM_TEST_CALLS
+          failed = failed .OR. test6()
+        END DO
+        IF (failed) THEN
+          failcode = failcode + 2**5
+        END IF
+#endif
+#ifndef T7
+        failed = .FALSE.
+        DO testrun = 1, NUM_TEST_CALLS
+          failed = failed .OR. test7()
+        END DO
+        IF (failed) THEN
+          failcode = failcode + 2**6
+        END IF
+#endif
+
+        CALL EXIT(failcode)
+      END PROGRAM