From 217b390ab9c644193b403320dc182b16fd93d303 Mon Sep 17 00:00:00 2001 From: Ryan Padrone Date: Sat, 24 Jan 2026 14:46:09 -0800 Subject: [PATCH 1/7] named constant allowed in fortran --- Tests/acc_named_constant.F90 | 303 +++++++++++++++++++++++++++++++++++ 1 file changed, 303 insertions(+) create mode 100644 Tests/acc_named_constant.F90 diff --git a/Tests/acc_named_constant.F90 b/Tests/acc_named_constant.F90 new file mode 100644 index 0000000..2773a6c --- /dev/null +++ b/Tests/acc_named_constant.F90 @@ -0,0 +1,303 @@ +! acc_named_constant_data_firstprivate.F90 +! +! Feature under test (OpenACC 3.4, Section 1.6): +! - A Fortran named constant (PARAMETER) is a valid "var" and is allowed +! in data clauses and firstprivate clauses. +! +! Notes: +! - We only use named constants in read-only ways (copyin/create/firstprivate) +! and never in a way that would require writing back to the constant. + +#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) errors = errors + 1 + 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) errors = errors + 1 + 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) errors = errors + 1 + 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) errors = errors + 1 + 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) errors = errors + 1 + 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) errors = errors + 1 + 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) errors = errors + 1 + 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) failcode = failcode + 2**0 +#endif +#ifndef T2 + failed = .FALSE. + DO testrun = 1, NUM_TEST_CALLS + failed = failed .OR. test2() + END DO + IF (failed) failcode = failcode + 2**1 +#endif +#ifndef T3 + failed = .FALSE. + DO testrun = 1, NUM_TEST_CALLS + failed = failed .OR. test3() + END DO + IF (failed) failcode = failcode + 2**2 +#endif +#ifndef T4 + failed = .FALSE. + DO testrun = 1, NUM_TEST_CALLS + failed = failed .OR. test4() + END DO + IF (failed) failcode = failcode + 2**3 +#endif +#ifndef T5 + failed = .FALSE. + DO testrun = 1, NUM_TEST_CALLS + failed = failed .OR. test5() + END DO + IF (failed) failcode = failcode + 2**4 +#endif +#ifndef T6 + failed = .FALSE. + DO testrun = 1, NUM_TEST_CALLS + failed = failed .OR. test6() + END DO + IF (failed) failcode = failcode + 2**5 +#endif +#ifndef T7 + failed = .FALSE. + DO testrun = 1, NUM_TEST_CALLS + failed = failed .OR. test7() + END DO + IF (failed) failcode = failcode + 2**6 +#endif + + CALL EXIT(failcode) + END PROGRAM From 37a5f19a3058dc4b8b5eb54587fb025a0f5c4f84 Mon Sep 17 00:00:00 2001 From: Ryanpadrone <159075564+Ryanpadrone@users.noreply.github.com> Date: Mon, 2 Feb 2026 20:18:47 -0500 Subject: [PATCH 2/7] Rename acc_named_constant.F90 to acc_named_constant_data_firstprivate.F90 changed name of file --- ...amed_constant.F90 => acc_named_constant_data_firstprivate.F90} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename Tests/{acc_named_constant.F90 => acc_named_constant_data_firstprivate.F90} (100%) diff --git a/Tests/acc_named_constant.F90 b/Tests/acc_named_constant_data_firstprivate.F90 similarity index 100% rename from Tests/acc_named_constant.F90 rename to Tests/acc_named_constant_data_firstprivate.F90 From 2d88d7404c485d971540000066dd6addd4524e55 Mon Sep 17 00:00:00 2001 From: Ryanpadrone <159075564+Ryanpadrone@users.noreply.github.com> Date: Thu, 12 Feb 2026 19:38:14 -0500 Subject: [PATCH 3/7] Update acc_named_constant_data_firstprivate.F90 --- Tests/acc_named_constant_data_firstprivate.F90 | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) diff --git a/Tests/acc_named_constant_data_firstprivate.F90 b/Tests/acc_named_constant_data_firstprivate.F90 index 2773a6c..6c5e027 100644 --- a/Tests/acc_named_constant_data_firstprivate.F90 +++ b/Tests/acc_named_constant_data_firstprivate.F90 @@ -1,12 +1,15 @@ -! acc_named_constant_data_firstprivate.F90 +! acc_pqr_list.F90 ! ! Feature under test (OpenACC 3.4, Section 1.6): -! - A Fortran named constant (PARAMETER) is a valid "var" and is allowed -! in data clauses and firstprivate clauses. +! - A pqr-list must contain at least one item. +! - A pqr-list must not have a trailing comma. ! -! Notes: -! - We only use named constants in read-only ways (copyin/create/firstprivate) -! and never in a way that would require writing back to the constant. +! This test exercises valid pqr-list usage in: +! - var-lists (copyin, copy) +! - int-expr-lists (wait) +! +! Only spec-compliant (non-empty, no trailing comma) forms are used. + #ifndef T1 !T1:syntax,firstprivate,runtime,compute,V:3.4- From 13db4ac07c5d6c4abf3d8b1f314b9dfe0830b389 Mon Sep 17 00:00:00 2001 From: Ryanpadrone <159075564+Ryanpadrone@users.noreply.github.com> Date: Thu, 12 Feb 2026 19:49:08 -0500 Subject: [PATCH 4/7] Update acc_named_constant_data_firstprivate.F90 --- Tests/acc_named_constant_data_firstprivate.F90 | 14 ++++++-------- 1 file changed, 6 insertions(+), 8 deletions(-) diff --git a/Tests/acc_named_constant_data_firstprivate.F90 b/Tests/acc_named_constant_data_firstprivate.F90 index 6c5e027..7552096 100644 --- a/Tests/acc_named_constant_data_firstprivate.F90 +++ b/Tests/acc_named_constant_data_firstprivate.F90 @@ -1,14 +1,12 @@ -! acc_pqr_list.F90 +! acc_named_constant_data_firstprivate.F90 ! ! Feature under test (OpenACC 3.4, Section 1.6): -! - A pqr-list must contain at least one item. -! - A pqr-list must not have a trailing comma. +! - A Fortran named constant (PARAMETER) is a valid "var" and is allowed +! in data clauses and firstprivate clauses. ! -! This test exercises valid pqr-list usage in: -! - var-lists (copyin, copy) -! - int-expr-lists (wait) -! -! Only spec-compliant (non-empty, no trailing comma) forms are used. +! Notes: +! - We only use named constants in read-only ways (copyin/create/firstprivate) +! and never in a way that would require writing back to the constant. #ifndef T1 From f7f7299ca32ade1aae57f4b269b56972d3c8e21f Mon Sep 17 00:00:00 2001 From: Ryanpadrone <159075564+Ryanpadrone@users.noreply.github.com> Date: Thu, 12 Feb 2026 20:15:40 -0500 Subject: [PATCH 5/7] Update acc_named_constant_data_firstprivate.F90 --- Tests/acc_named_constant_data_firstprivate.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Tests/acc_named_constant_data_firstprivate.F90 b/Tests/acc_named_constant_data_firstprivate.F90 index 7552096..a613593 100644 --- a/Tests/acc_named_constant_data_firstprivate.F90 +++ b/Tests/acc_named_constant_data_firstprivate.F90 @@ -1,6 +1,6 @@ ! acc_named_constant_data_firstprivate.F90 ! -! Feature under test (OpenACC 3.4, Section 1.6): +! 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. ! From ece90b8bd8be971154ce4e2e31ca07e96c54446a Mon Sep 17 00:00:00 2001 From: Ryanpadrone <159075564+Ryanpadrone@users.noreply.github.com> Date: Wed, 18 Feb 2026 18:38:52 -0500 Subject: [PATCH 6/7] Update acc_named_constant_data_firstprivate.F90 --- .../acc_named_constant_data_firstprivate.F90 | 78 +++++++++++++++---- 1 file changed, 62 insertions(+), 16 deletions(-) diff --git a/Tests/acc_named_constant_data_firstprivate.F90 b/Tests/acc_named_constant_data_firstprivate.F90 index a613593..5838c4d 100644 --- a/Tests/acc_named_constant_data_firstprivate.F90 +++ b/Tests/acc_named_constant_data_firstprivate.F90 @@ -5,8 +5,26 @@ ! in data clauses and firstprivate clauses. ! ! Notes: -! - We only use named constants in read-only ways (copyin/create/firstprivate) -! and never in a way that would require writing back to the constant. +! T1: A Fortran INTEGER PARAMETER can appear in a firstprivate clause. +! This test checks it is correctly available on the device. +! +! T2: A Fortran REAL PARAMETER can appear in a firstprivate clause. +! This test checks it works correctly on the device. +! +! T3: A Fortran PARAMETER can appear in a data clause (copyin). +! This test checks it is usable inside a device region. +! +! T4: A PARAMETER array can appear in a firstprivate clause. +! This test checks correct device behavior. +! +! T5: A PARAMETER array can appear in a data clause (copyin). +! This test checks it is accessible on the device. +! +! T6: A PARAMETER can appear in a create clause. +! This test checks it can be used on the device. +! +! T7: A PARAMETER can appear in present_or_copyin. +! This test checks correct device access. #ifndef T1 @@ -32,7 +50,9 @@ LOGICAL FUNCTION test1() !$acc end data DO i = 1, LOOPCOUNT - IF (ABS(c(i) - (a(i) + DBLE(K))) .GT. PRECISION) errors = errors + 1 + IF (ABS(c(i) - (a(i) + DBLE(K))) .GT. PRECISION) THEN + errors = errors + 1 + END IF END DO test1 = (errors .NE. 0) @@ -62,7 +82,9 @@ LOGICAL FUNCTION test2() !$acc end data DO i = 1, LOOPCOUNT - IF (ABS(c(i) - (ALPHA * a(i))) .GT. PRECISION) errors = errors + 1 + IF (ABS(c(i) - (ALPHA * a(i))) .GT. PRECISION) THEN + errors = errors + 1 + END IF END DO test2 = (errors .NE. 0) @@ -93,7 +115,9 @@ LOGICAL FUNCTION test3() !$acc end data DO i = 1, LOOPCOUNT - IF (ABS(c(i) - (a(i) + DBLE(SHIFT))) .GT. PRECISION) errors = errors + 1 + IF (ABS(c(i) - (a(i) + DBLE(SHIFT))) .GT. PRECISION) THEN + errors = errors + 1 + END IF END DO test3 = (errors .NE. 0) @@ -123,7 +147,9 @@ LOGICAL FUNCTION test4() !$acc end data DO i = 1, LOOPCOUNT - IF (ABS(c(i) - (W(1) * a(i) + W(2))) .GT. PRECISION) errors = errors + 1 + IF (ABS(c(i) - (W(1) * a(i) + W(2))) .GT. PRECISION) THEN + errors = errors + 1 + END IF END DO test4 = (errors .NE. 0) @@ -154,7 +180,9 @@ LOGICAL FUNCTION test5() !$acc end data DO i = 1, LOOPCOUNT - IF (ABS(c(i) - (BIAS(2) * a(i) + BIAS(1))) .GT. PRECISION) errors = errors + 1 + IF (ABS(c(i) - (BIAS(2) * a(i) + BIAS(1))) .GT. PRECISION) THEN + errors = errors + 1 + END IF END DO test5 = (errors .NE. 0) @@ -184,7 +212,9 @@ LOGICAL FUNCTION test6() !$acc end data DO i = 1, LOOPCOUNT - IF (ABS(c(i) - (DBLE(MULT) * a(i))) .GT. PRECISION) errors = errors + 1 + IF (ABS(c(i) - (DBLE(MULT) * a(i))) .GT. PRECISION) THEN + errors = errors + 1 + END IF END DO test6 = (errors .NE. 0) @@ -214,7 +244,9 @@ LOGICAL FUNCTION test7() !$acc end data DO i = 1, LOOPCOUNT - IF (ABS(c(i) - (a(i) + DBLE(OFF))) .GT. PRECISION) errors = errors + 1 + IF (ABS(c(i) - (a(i) + DBLE(OFF))) .GT. PRECISION) THEN + errors = errors + 1 + END IF END DO test7 = (errors .NE. 0) @@ -255,49 +287,63 @@ PROGRAM main DO testrun = 1, NUM_TEST_CALLS failed = failed .OR. test1() END DO - IF (failed) failcode = failcode + 2**0 + 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) failcode = failcode + 2**1 + 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) failcode = failcode + 2**2 + 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) failcode = failcode + 2**3 + 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) failcode = failcode + 2**4 + 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) failcode = failcode + 2**5 + 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) failcode = failcode + 2**6 + IF (failed) THEN + failcode = failcode + 2**6 + END IF #endif CALL EXIT(failcode) From 4b7048d13dbc81f750b1d65ce593638f8f755a9b Mon Sep 17 00:00:00 2001 From: Ryanpadrone <159075564+Ryanpadrone@users.noreply.github.com> Date: Wed, 18 Feb 2026 19:31:16 -0500 Subject: [PATCH 7/7] Update acc_named_constant_data_firstprivate.F90 --- Tests/acc_named_constant_data_firstprivate.F90 | 14 +------------- 1 file changed, 1 insertion(+), 13 deletions(-) diff --git a/Tests/acc_named_constant_data_firstprivate.F90 b/Tests/acc_named_constant_data_firstprivate.F90 index 5838c4d..4f3e0f6 100644 --- a/Tests/acc_named_constant_data_firstprivate.F90 +++ b/Tests/acc_named_constant_data_firstprivate.F90 @@ -6,25 +6,13 @@ ! ! Notes: ! T1: A Fortran INTEGER PARAMETER can appear in a firstprivate clause. -! This test checks it is correctly available on the device. -! ! T2: A Fortran REAL PARAMETER can appear in a firstprivate clause. -! This test checks it works correctly on the device. -! ! T3: A Fortran PARAMETER can appear in a data clause (copyin). -! This test checks it is usable inside a device region. -! ! T4: A PARAMETER array can appear in a firstprivate clause. -! This test checks correct device behavior. -! ! T5: A PARAMETER array can appear in a data clause (copyin). -! This test checks it is accessible on the device. -! ! T6: A PARAMETER can appear in a create clause. -! This test checks it can be used on the device. -! ! T7: A PARAMETER can appear in present_or_copyin. -! This test checks correct device access. +! #ifndef T1