Hi Tobias,
On 8/7/2025 8:59 PM, Tobias Burnus wrote:
Yuao Ma wrote:
Given the "Fortran 2023:" prefix, I wonder whether the wording shouldn't
be tweaked:
+ call c_f_pointer(x, ptr_2d, shape=myshape_2d, lower=mylower_2d) !
{ dg-error "Fortran 2023: Unexpected LOWER argument at" }
It reads a bit as if with Fortran 2023, it is unexpected - but it is
unexpected only with older versions.
I wonder whether it is clearer using: "Error: Fortran 2023: LOWER
argument at"
Yes I agree. Done.
* * *
* I have a minor documentation nit; current wording is
at https://gcc.gnu.org/onlinedocs/gfortran/C_005fF_005fPOINTER.html
Namely, ...
Yuao Ma wrote:
--- a/gcc/fortran/intrinsic.texi
+++ b/gcc/fortran/intrinsic.texi
@@ -3368,10 +3368,10 @@ Fortran 2003 and later
@table @asis
@item @emph{Synopsis}:
-@code{CALL C_F_POINTER(CPTR, FPTR[, SHAPE])}
+@code{CALL C_F_POINTER(CPTR, FPTR[, SHAPE, LOWER])}
@item @emph{Description}:
-@code{C_F_POINTER(CPTR, FPTR[, SHAPE])} assigns the target of the
C pointer
+@code{C_F_POINTER(CPTR, FPTR[, SHAPE, LOWER])} assigns the target
of the C pointer
@var{CPTR} to the Fortran pointer @var{FPTR} and specifies its
shape.
I think some wording like the following is missing:
"For an array @var{FPTR}, the lower bounds are specified by
@var{LOWER} if present and otherwise equal to 1."
Done.
Actually, I wonder whether this wording is better placed at the end of
"Description:" instead of under "Arguments:" for 'LOWER'
See https://gcc.gnu.org/onlinedocs/gfortran/C_005fF_005fPOINTER.html for
how it currently looks.
Do you concur?
Both seem good to me. Done.
PS: FYI – contrib/download_prerequisites now downloads MPFR 4.2.2, i.e.
it will have the 'pi' support.
Great to hear that. Thank you for your effort!
PPS: I am aware of other emails, esp. related to libquadmath, which
someone (me?) should be take care of …
That would be great, thanks!
I think the libquadmath patch is ready to go from the current policy.
For future optimizations, we should always handle them in glibc first.
The Fortran part of libquadmath is only needed for systems with older
versions of glibc, so I believe importing from glibc will be sufficient
for now. (It's worth noting that even the core-math project doesn't have
trig-pi functions for binary80/128).
In addition to the libquadmath patch, there are two others:
* The libgfortran fallback: Joseph suggested we can learn from the glibc
implementation to achieve higher precision here. I'll find some time to
work on this.
* The conditional expression patch: It only supports basic types and
doesn't work with strings, arrays, etc. Adding a new expression type is
proving more difficult than I initially thought, as it requires careful
handling every time we switch against an expression type. I'm hoping to
implement this incrementally to make life easier.
And:
PS: Eventually, we should update https://gcc.gnu.org/gcc-16/
changes.html for the accumulated Fortran changes … [That's the
https://gcc.gnu.org/ about.html#git ]
Yes, we could summarize the work done for Fortran 2023, similar to
how the Flang documentation(https://flang.llvm.org/docs/
FortranStandardsSupport.html#fortran-2023) does.
I think that's two separate documents:
One is about the news (release news, changes),
i.e. gcc.gnu.org/gcc-16/changes.html for the current pending changes,
https://gcc.gnu.org/gcc-15/changes.html#fortran is what we had last year.
That's somewhat easy as we only need to add the new stuff and it is just
unfortunate but not wrong to miss some features.
This is useful & has a low effort.
The other is to have a supported-feature list. That's quite nice,
but requires more maintenance work.
We have this kind of lists already in GCC:
For C:https://gcc.gnu.org/projects/c-status.html
For C++:https://gcc.gnu.org/projects/cxx-status.html
For the C++ standard
library:https://gcc.gnu.org/onlinedocs/libstdc++/manual/status.html
For OpenMP - by version:https://gcc.gnu.org/projects/gomp/#implementation-status
and for a specific version (here mainline)
https://gcc.gnu.org/onlinedocs/libgomp/OpenMP-Implementation-Status.html
(in the .texi file, i.e. it also ships with GCC).
For gfortran, we have in the wiki →https://gcc.gnu.org/wiki/GFortran namely:
https://gcc.gnu.org/wiki/Fortran2003Status
https://gcc.gnu.org/wiki/Fortran2008Status
https://gcc.gnu.org/wiki/Fortran2018Status
https://gcc.gnu.org/wiki/TS29113Status
I think this has bitrotted a bit and a Fortran2023 version is missing.
And some statuses are outdated, like move_alloc being marked as unsupported.
Thanks for the review and explanation!
Yuao
From 590cce1b335c781355d8518ad9c14502b127130a Mon Sep 17 00:00:00 2001
From: Yuao Ma <c...@outlook.com>
Date: Thu, 7 Aug 2025 22:35:17 +0800
Subject: [PATCH] fortran: add optional lower arg to c_f_pointer
This patch adds support for the optional lower argument in intrinsic
c_f_pointer specified in Fortran 2023. Test cases and documentation have also
been updated.
gcc/fortran/ChangeLog:
* check.cc (gfc_check_c_f_pointer): Check lower arg legitimacy.
* intrinsic.cc (add_subroutines): Teach c_f_pointer about lower arg.
* intrinsic.h (gfc_check_c_f_pointer): Add lower arg.
* intrinsic.texi: Update lower arg for c_f_pointer.
* trans-intrinsic.cc (conv_isocbinding_subroutine): Add logic handle
lower.
gcc/testsuite/ChangeLog:
* gfortran.dg/c_f_pointer_shape_tests_7.f90: New test.
* gfortran.dg/c_f_pointer_shape_tests_8.f90: New test.
* gfortran.dg/c_f_pointer_shape_tests_9.f90: New test.
Signed-off-by: Yuao Ma <c...@outlook.com>
---
gcc/fortran/check.cc | 40 +++++++-
gcc/fortran/intrinsic.cc | 5 +-
gcc/fortran/intrinsic.h | 2 +-
gcc/fortran/intrinsic.texi | 18 ++--
gcc/fortran/trans-intrinsic.cc | 98 +++++++++++++------
.../gfortran.dg/c_f_pointer_shape_tests_7.f90 | 35 +++++++
.../gfortran.dg/c_f_pointer_shape_tests_8.f90 | 24 +++++
.../gfortran.dg/c_f_pointer_shape_tests_9.f90 | 17 ++++
8 files changed, 196 insertions(+), 43 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/c_f_pointer_shape_tests_7.f90
create mode 100644 gcc/testsuite/gfortran.dg/c_f_pointer_shape_tests_8.f90
create mode 100644 gcc/testsuite/gfortran.dg/c_f_pointer_shape_tests_9.f90
diff --git a/gcc/fortran/check.cc b/gcc/fortran/check.cc
index 862652683a7..80aac89c333 100644
--- a/gcc/fortran/check.cc
+++ b/gcc/fortran/check.cc
@@ -6081,7 +6081,8 @@ gfc_check_c_associated (gfc_expr *c_ptr_1, gfc_expr
*c_ptr_2)
bool
-gfc_check_c_f_pointer (gfc_expr *cptr, gfc_expr *fptr, gfc_expr *shape)
+gfc_check_c_f_pointer (gfc_expr *cptr, gfc_expr *fptr, gfc_expr *shape,
+ gfc_expr *lower)
{
symbol_attribute attr;
const char *msg;
@@ -6156,6 +6157,43 @@ gfc_check_c_f_pointer (gfc_expr *cptr, gfc_expr *fptr,
gfc_expr *shape)
}
}
+ if (lower
+ && !gfc_notify_std (GFC_STD_F2023, "LOWER argument at %L to C_F_POINTER",
+ &lower->where))
+ return false;
+
+ if (!shape && lower)
+ {
+ gfc_error ("Unexpected LOWER argument at %L to C_F_POINTER "
+ "with scalar FPTR",
+ &lower->where);
+ return false;
+ }
+
+ if (lower && !rank_check (lower, 3, 1))
+ return false;
+
+ if (lower && !type_check (lower, 3, BT_INTEGER))
+ return false;
+
+ if (lower)
+ {
+ mpz_t size;
+ if (gfc_array_size (lower, &size))
+ {
+ if (mpz_cmp_ui (size, fptr->rank) != 0)
+ {
+ mpz_clear (size);
+ gfc_error (
+ "LOWER argument at %L to C_F_POINTER must have the same "
+ "size as the RANK of FPTR",
+ &lower->where);
+ return false;
+ }
+ mpz_clear (size);
+ }
+ }
+
if (fptr->ts.type == BT_CLASS)
{
gfc_error ("Polymorphic FPTR at %L to C_F_POINTER", &fptr->where);
diff --git a/gcc/fortran/intrinsic.cc b/gcc/fortran/intrinsic.cc
index c99a7a86aea..e2847f08daa 100644
--- a/gcc/fortran/intrinsic.cc
+++ b/gcc/fortran/intrinsic.cc
@@ -3943,11 +3943,12 @@ add_subroutines (void)
/* The following subroutines are part of ISO_C_BINDING. */
- add_sym_3s ("c_f_pointer", GFC_ISYM_C_F_POINTER, CLASS_IMPURE, BT_UNKNOWN, 0,
+ add_sym_4s ("c_f_pointer", GFC_ISYM_C_F_POINTER, CLASS_IMPURE, BT_UNKNOWN, 0,
GFC_STD_F2003, gfc_check_c_f_pointer, NULL, NULL,
"cptr", BT_VOID, 0, REQUIRED, INTENT_IN,
"fptr", BT_UNKNOWN, 0, REQUIRED, INTENT_OUT,
- "shape", BT_INTEGER, di, OPTIONAL, INTENT_IN);
+ "shape", BT_INTEGER, di, OPTIONAL, INTENT_IN,
+ "lower", BT_INTEGER, di, OPTIONAL, INTENT_IN);
make_from_module();
add_sym_2s ("c_f_procpointer", GFC_ISYM_C_F_PROCPOINTER, CLASS_IMPURE,
diff --git a/gcc/fortran/intrinsic.h b/gcc/fortran/intrinsic.h
index 8a0ab935e1f..048196d65c3 100644
--- a/gcc/fortran/intrinsic.h
+++ b/gcc/fortran/intrinsic.h
@@ -165,7 +165,7 @@ bool gfc_check_sign (gfc_expr *, gfc_expr *);
bool gfc_check_signal (gfc_expr *, gfc_expr *);
bool gfc_check_sizeof (gfc_expr *);
bool gfc_check_c_associated (gfc_expr *, gfc_expr *);
-bool gfc_check_c_f_pointer (gfc_expr *, gfc_expr *, gfc_expr *);
+bool gfc_check_c_f_pointer (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
bool gfc_check_c_f_procpointer (gfc_expr *, gfc_expr *);
bool gfc_check_c_funloc (gfc_expr *);
bool gfc_check_c_loc (gfc_expr *);
diff --git a/gcc/fortran/intrinsic.texi b/gcc/fortran/intrinsic.texi
index a24b234316c..3941914f622 100644
--- a/gcc/fortran/intrinsic.texi
+++ b/gcc/fortran/intrinsic.texi
@@ -3368,11 +3368,13 @@ Fortran 2003 and later
@table @asis
@item @emph{Synopsis}:
-@code{CALL C_F_POINTER(CPTR, FPTR[, SHAPE])}
+@code{CALL C_F_POINTER(CPTR, FPTR[, SHAPE, LOWER])}
@item @emph{Description}:
-@code{C_F_POINTER(CPTR, FPTR[, SHAPE])} assigns the target of the C pointer
-@var{CPTR} to the Fortran pointer @var{FPTR} and specifies its shape.
+@code{C_F_POINTER(CPTR, FPTR[, SHAPE, LOWER])} assigns the target of the C
+pointer @var{CPTR} to the Fortran pointer @var{FPTR} and specifies its shape.
+For an array @var{FPTR}, the lower bounds are specified by @var{LOWER} if
+present and otherwise equal to 1.
@item @emph{Class}:
Subroutine
@@ -3384,9 +3386,11 @@ Subroutine
@item @var{FPTR} @tab pointer interoperable with @var{cptr}. It is
@code{INTENT(OUT)}.
@item @var{SHAPE} @tab (Optional) Rank-one array of type @code{INTEGER}
-with @code{INTENT(IN)}. It shall be present
-if and only if @var{fptr} is an array. The size
-must be equal to the rank of @var{fptr}.
+with @code{INTENT(IN)}. It shall be present if and only if @var{FPTR} is an
+array. The size must be equal to the rank of @var{FPTR}.
+@item @var{LOWER} @tab (Optional) Rank-one array of type @code{INTEGER}
+with @code{INTENT(IN)}. It shall not be present if @var{SHAPE} is not present.
+The size must be equal to the rank of @var{FPTR}.
@end multitable
@item @emph{Example}:
@@ -3408,7 +3412,7 @@ end program main
@end smallexample
@item @emph{Standard}:
-Fortran 2003 and later
+Fortran 2003 and later, with @var{LOWER} argument Fortran 2023 and later
@item @emph{See also}:
@ref{C_LOC}, @*
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index f68ceb18820..71556b1c4ef 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -9918,38 +9918,40 @@ conv_isocbinding_function (gfc_se *se, gfc_expr *expr)
static tree
conv_isocbinding_subroutine (gfc_code *code)
{
- gfc_se se;
- gfc_se cptrse;
- gfc_se fptrse;
- gfc_se shapese;
- gfc_ss *shape_ss;
- tree desc, dim, tmp, stride, offset;
+ gfc_expr *cptr, *fptr, *shape, *lower;
+ gfc_se se, cptrse, fptrse, shapese, lowerse;
+ gfc_ss *shape_ss, *lower_ss;
+ tree desc, dim, tmp, stride, offset, lbound, ubound;
stmtblock_t body, block;
gfc_loopinfo loop;
- gfc_actual_arglist *arg = code->ext.actual;
+ gfc_actual_arglist *arg;
+
+ arg = code->ext.actual;
+ cptr = arg->expr;
+ fptr = arg->next->expr;
+ shape = arg->next->next ? arg->next->next->expr : NULL;
+ lower = shape && arg->next->next->next ? arg->next->next->next->expr : NULL;
gfc_init_se (&se, NULL);
gfc_init_se (&cptrse, NULL);
- gfc_conv_expr (&cptrse, arg->expr);
+ gfc_conv_expr (&cptrse, cptr);
gfc_add_block_to_block (&se.pre, &cptrse.pre);
gfc_add_block_to_block (&se.post, &cptrse.post);
gfc_init_se (&fptrse, NULL);
- if (arg->next->expr->rank == 0)
+ if (fptr->rank == 0)
{
fptrse.want_pointer = 1;
- gfc_conv_expr (&fptrse, arg->next->expr);
+ gfc_conv_expr (&fptrse, fptr);
gfc_add_block_to_block (&se.pre, &fptrse.pre);
gfc_add_block_to_block (&se.post, &fptrse.post);
- if (arg->next->expr->symtree->n.sym->attr.proc_pointer
- && arg->next->expr->symtree->n.sym->attr.dummy)
- fptrse.expr = build_fold_indirect_ref_loc (input_location,
- fptrse.expr);
- se.expr = fold_build2_loc (input_location, MODIFY_EXPR,
- TREE_TYPE (fptrse.expr),
- fptrse.expr,
- fold_convert (TREE_TYPE (fptrse.expr),
- cptrse.expr));
+ if (fptr->symtree->n.sym->attr.proc_pointer
+ && fptr->symtree->n.sym->attr.dummy)
+ fptrse.expr = build_fold_indirect_ref_loc (input_location, fptrse.expr);
+ se.expr
+ = fold_build2_loc (input_location, MODIFY_EXPR, TREE_TYPE (fptrse.expr),
+ fptrse.expr,
+ fold_convert (TREE_TYPE (fptrse.expr), cptrse.expr));
gfc_add_expr_to_block (&se.pre, se.expr);
gfc_add_block_to_block (&se.pre, &se.post);
return gfc_finish_block (&se.pre);
@@ -9959,7 +9961,7 @@ conv_isocbinding_subroutine (gfc_code *code)
/* Get the descriptor of the Fortran pointer. */
fptrse.descriptor_only = 1;
- gfc_conv_expr_descriptor (&fptrse, arg->next->expr);
+ gfc_conv_expr_descriptor (&fptrse, fptr);
gfc_add_block_to_block (&block, &fptrse.pre);
desc = fptrse.expr;
@@ -9976,18 +9978,33 @@ conv_isocbinding_subroutine (gfc_code *code)
/* Start scalarization of the bounds, using the shape argument. */
- shape_ss = gfc_walk_expr (arg->next->next->expr);
+ shape_ss = gfc_walk_expr (shape);
gcc_assert (shape_ss != gfc_ss_terminator);
gfc_init_se (&shapese, NULL);
+ if (lower)
+ {
+ lower_ss = gfc_walk_expr (lower);
+ gcc_assert (lower_ss != gfc_ss_terminator);
+ gfc_init_se (&lowerse, NULL);
+ }
gfc_init_loopinfo (&loop);
gfc_add_ss_to_loop (&loop, shape_ss);
+ if (lower)
+ gfc_add_ss_to_loop (&loop, lower_ss);
gfc_conv_ss_startstride (&loop);
- gfc_conv_loop_setup (&loop, &arg->next->expr->where);
+ gfc_conv_loop_setup (&loop, &fptr->where);
gfc_mark_ss_chain_used (shape_ss, 1);
+ if (lower)
+ gfc_mark_ss_chain_used (lower_ss, 1);
gfc_copy_loopinfo_to_se (&shapese, &loop);
shapese.ss = shape_ss;
+ if (lower)
+ {
+ gfc_copy_loopinfo_to_se (&lowerse, &loop);
+ lowerse.ss = lower_ss;
+ }
stride = gfc_create_var (gfc_array_index_type, "stride");
offset = gfc_create_var (gfc_array_index_type, "offset");
@@ -9998,27 +10015,44 @@ conv_isocbinding_subroutine (gfc_code *code)
gfc_start_scalarized_body (&loop, &body);
dim = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
- loop.loopvar[0], loop.from[0]);
+ loop.loopvar[0], loop.from[0]);
+
+ if (lower)
+ {
+ gfc_conv_expr (&lowerse, lower);
+ gfc_add_block_to_block (&body, &lowerse.pre);
+ lbound = fold_convert (gfc_array_index_type, lowerse.expr);
+ gfc_add_block_to_block (&body, &lowerse.post);
+ }
+ else
+ lbound = gfc_index_one_node;
/* Set bounds and stride. */
- gfc_conv_descriptor_lbound_set (&body, desc, dim, gfc_index_one_node);
+ gfc_conv_descriptor_lbound_set (&body, desc, dim, lbound);
gfc_conv_descriptor_stride_set (&body, desc, dim, stride);
- gfc_conv_expr (&shapese, arg->next->next->expr);
+ gfc_conv_expr (&shapese, shape);
gfc_add_block_to_block (&body, &shapese.pre);
- gfc_conv_descriptor_ubound_set (&body, desc, dim, shapese.expr);
+ ubound = fold_build2_loc (
+ input_location, MINUS_EXPR, gfc_array_index_type,
+ fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type, lbound,
+ fold_convert (gfc_array_index_type, shapese.expr)),
+ gfc_index_one_node);
+ gfc_conv_descriptor_ubound_set (&body, desc, dim, ubound);
gfc_add_block_to_block (&body, &shapese.post);
/* Calculate offset. */
+ tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+ stride, lbound);
gfc_add_modify (&body, offset,
fold_build2_loc (input_location, PLUS_EXPR,
- gfc_array_index_type, offset, stride));
+ gfc_array_index_type, offset, tmp));
+
/* Update stride. */
- gfc_add_modify (&body, stride,
- fold_build2_loc (input_location, MULT_EXPR,
- gfc_array_index_type, stride,
- fold_convert (gfc_array_index_type,
- shapese.expr)));
+ gfc_add_modify (
+ &body, stride,
+ fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type, stride,
+ fold_convert (gfc_array_index_type, shapese.expr)));
/* Finish scalarization loop. */
gfc_trans_scalarizing_loops (&loop, &body);
gfc_add_block_to_block (&block, &loop.pre);
diff --git a/gcc/testsuite/gfortran.dg/c_f_pointer_shape_tests_7.f90
b/gcc/testsuite/gfortran.dg/c_f_pointer_shape_tests_7.f90
new file mode 100644
index 00000000000..3504e682f05
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_f_pointer_shape_tests_7.f90
@@ -0,0 +1,35 @@
+! { dg-do run }
+! { dg-options "-std=f2023" }
+program lower
+ use iso_c_binding
+ type(c_ptr) :: x
+ integer, target :: array_2d(12), array_3d(24)
+ integer, pointer :: ptr_2d(:, :), ptr_3d(:, :, :)
+ integer :: myshape_2d(2), myshape_3d(3)
+ integer :: mylower_2d(2), mylower_3d(3)
+
+ array_2d = [1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12]
+ x = c_loc(array_2d)
+ myshape_2d = [3, 4]
+ mylower_2d = [2, 2]
+
+ call c_f_pointer(x, ptr_2d, shape=myshape_2d, lower=mylower_2d)
+ if (any(lbound(ptr_2d) /= [2, 2])) stop 1
+ if (any(ubound(ptr_2d) /= [4, 5])) stop 2
+ if (any(shape(ptr_2d) /= [3, 4])) stop 3
+ if (ptr_2d(2, 2) /= 1) stop 4
+ if (ptr_2d(3, 4) /= 8) stop 5
+ if (ptr_2d(4, 5) /= 12) stop 6
+
+ array_3d = [1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18,
19, 20, 21, 22, 23, 24]
+ x = c_loc(array_3d)
+ myshape_3d = [2, 3, 4]
+ mylower_3d = [-1, -2, -3]
+
+ call c_f_pointer(x, ptr_3d, shape=myshape_3d, lower=mylower_3d)
+ if (any(lbound(ptr_3d) /= [-1, -2, -3])) stop 7
+ if (any(ubound(ptr_3d) /= [0, 0, 0])) stop 8
+ if (any(shape(ptr_3d) /= [2, 3, 4])) stop 9
+ if (ptr_3d(0, 0, 0) /= 24) stop 10
+
+end program lower
diff --git a/gcc/testsuite/gfortran.dg/c_f_pointer_shape_tests_8.f90
b/gcc/testsuite/gfortran.dg/c_f_pointer_shape_tests_8.f90
new file mode 100644
index 00000000000..b9b851ac7dc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_f_pointer_shape_tests_8.f90
@@ -0,0 +1,24 @@
+! { dg-do compile }
+! { dg-options "-std=f2023" }
+! Verify that the type and rank of the LOWER argument are enforced.
+module c_f_pointer_shape_tests_8
+ use, intrinsic :: iso_c_binding
+
+contains
+ subroutine sub2(my_c_array) bind(c)
+ type(c_ptr), value :: my_c_array
+ integer(kind=c_int), dimension(:), pointer :: my_array_ptr
+
+ call c_f_pointer(my_c_array, my_array_ptr, (/ 10 /), (/ 10.0 /)) ! {
dg-error "must be INTEGER" }
+ end subroutine sub2
+
+ subroutine sub3(my_c_array) bind(c)
+ type(c_ptr), value :: my_c_array
+ integer(kind=c_int), dimension(:), pointer :: my_array_ptr
+ integer(kind=c_int), dimension(1) :: shape
+ integer(kind=c_int), dimension(1, 1) :: lower
+
+ lower(1, 1) = 10
+ call c_f_pointer(my_c_array, my_array_ptr, shape, lower) ! { dg-error
"must be of rank 1" }
+ end subroutine sub3
+end module c_f_pointer_shape_tests_8
diff --git a/gcc/testsuite/gfortran.dg/c_f_pointer_shape_tests_9.f90
b/gcc/testsuite/gfortran.dg/c_f_pointer_shape_tests_9.f90
new file mode 100644
index 00000000000..e501e3d9b4e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_f_pointer_shape_tests_9.f90
@@ -0,0 +1,17 @@
+! { dg-do compile }
+! { dg-options "-std=f2018" }
+program lower
+ use iso_c_binding
+ type(c_ptr) :: x
+ integer, target :: array_2d(12)
+ integer, pointer :: ptr_2d(:, :)
+ integer :: myshape_2d(2)
+ integer :: mylower_2d(2)
+
+ array_2d = [1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12]
+ x = c_loc(array_2d)
+ myshape_2d = [3, 4]
+ mylower_2d = [2, 2]
+
+ call c_f_pointer(x, ptr_2d, shape=myshape_2d, lower=mylower_2d) ! { dg-error
"Fortran 2023: LOWER argument at" }
+end program lower
--
2.43.0
