This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[Patch, fortran] LBOUND/UBOUND/SHAPE assumed rank support
- From: Mikael Morin <mikael dot morin at sfr dot fr>
- To: gfortran <fortran at gcc dot gnu dot org>, gcc-patches <gcc-patches at gcc dot gnu dot org>
- Date: Thu, 02 Aug 2012 16:17:13 +0200
- Subject: [Patch, fortran] LBOUND/UBOUND/SHAPE assumed rank support
Hello,
as promised, I submit the patch (split to 5 pieces) adding support for
assumed rank actual arguments to the LBOUND/UBOUND/SHAPE intrinsics in
the non-scalar case (without the DIM argument).
Patch 1: Disable shape setting and simplification for assumed rank.
Patch 2: Move and rename get_rank_from_desc to gfc_conv_descriptor_rank.
Patch 3: Fix set_loop_bounds #1 (optional).
Patch 4: Fix set_loop_bounds #2.
Patch 5: Properly setup the scalarizer in the {l,u}bound(assumed_rank)
cases.
More details in the patch files.
Regression tested on x86_64-unknown-linux-gnu. OK for trunk?
Mikael
the shape was incorrectly set to -1 at resolution time for those intrinsics.
This patch disables it.
Also disabled is the attempt to simplify shape in the assumed rank case.
{l,u}bound didn't need this; it was already done.
2012-08-02 Mikael Morin <mikael@gcc.gnu.org>
* iresolve.c (resolve_bound, gfc_resolve_shape):
Don't set the shape for assumed rank arrays.
* simplify.c (gfc_simplify_shape): Don't try to simplify if the
argument is assumed rank.
diff --git a/iresolve.c b/iresolve.c
index 6d1e8b2..3ebf0c0 100644
--- a/iresolve.c
+++ b/iresolve.c
@@ -134,9 +134,12 @@ resolve_bound (gfc_expr *f, gfc_expr *array, gfc_expr *dim, gfc_expr *kind,
if (dim == NULL)
{
f->rank = 1;
- f->shape = gfc_get_shape (1);
- mpz_init_set_ui (f->shape[0], coarray ? gfc_get_corank (array)
- : array->rank);
+ if (array->rank != -1)
+ {
+ f->shape = gfc_get_shape (1);
+ mpz_init_set_ui (f->shape[0], coarray ? gfc_get_corank (array)
+ : array->rank);
+ }
}
f->value.function.name = xstrdup (name);
@@ -2225,8 +2228,12 @@ gfc_resolve_shape (gfc_expr *f, gfc_expr *array, gfc_expr *kind)
f->ts.kind = gfc_default_integer_kind;
f->rank = 1;
- f->shape = gfc_get_shape (1);
- mpz_init_set_ui (f->shape[0], array->rank);
+ if (array->rank != -1)
+ {
+ f->shape = gfc_get_shape (1);
+ mpz_init_set_ui (f->shape[0], array->rank);
+ }
+
f->value.function.name = gfc_get_string (PREFIX ("shape_%d"), f->ts.kind);
}
diff --git a/simplify.c b/simplify.c
index c12675e..e4ccddf 100644
--- a/simplify.c
+++ b/simplify.c
@@ -5470,6 +5470,9 @@ gfc_simplify_shape (gfc_expr *source, gfc_expr *kind)
gfc_try t;
int k = get_kind (BT_INTEGER, kind, "SHAPE", gfc_default_integer_kind);
+ if (source->rank == -1)
+ return NULL;
+
result = gfc_get_array_expr (BT_INTEGER, k, &source->where);
if (source->rank == 0)
The final patch (number 5) needs to access the rank from the descriptor.
Thus, trans-intrinsic.c's get_rank_from_desc should be made public.
I took the opportunity to move it in trans-array.c and rename it in line
with other descriptor accessors (gfc_conv_descriptor_rank).
2012-08-02 Mikael Morin <mikael@gcc.gnu.org>
* trans-array.h (gfc_conv_descriptor_rank): New prototype.
* trans-array.c (gfc_conv_descriptor_rank): New function moved and
renamed ...
* trans-intrinsic.c (gfc_get_rank_from_desc): ... from this one.
(gfc_conv_intrinsic_rank, gfc_conv_intrinsic_bound,
gfc_conv_associated): Update calls.
diff --git a/trans-array.c b/trans-array.c
index 555d696..abdb9ea 100644
--- a/trans-array.c
+++ b/trans-array.c
@@ -249,6 +249,20 @@ gfc_conv_descriptor_dtype (tree desc)
tree
+gfc_conv_descriptor_rank (tree desc)
+{
+ tree tmp;
+ tree dtype;
+
+ dtype = gfc_conv_descriptor_dtype (desc);
+ tmp = build_int_cst (TREE_TYPE (dtype), GFC_DTYPE_RANK_MASK);
+ tmp = fold_build2_loc (input_location, BIT_AND_EXPR, TREE_TYPE (dtype),
+ dtype, tmp);
+ return fold_convert (gfc_get_int_type (gfc_default_integer_kind), tmp);
+}
+
+
+tree
gfc_get_descriptor_dimension (tree desc)
{
tree type, field;
diff --git a/trans-array.h b/trans-array.h
index b7ab806..5ad794a 100644
--- a/trans-array.h
+++ b/trans-array.h
@@ -154,6 +154,7 @@ tree gfc_conv_descriptor_data_get (tree);
tree gfc_conv_descriptor_data_addr (tree);
tree gfc_conv_descriptor_offset_get (tree);
tree gfc_conv_descriptor_dtype (tree);
+tree gfc_conv_descriptor_rank (tree);
tree gfc_get_descriptor_dimension (tree);
tree gfc_conv_descriptor_stride_get (tree, tree);
tree gfc_conv_descriptor_lbound_get (tree, tree);
diff --git a/trans-intrinsic.c b/trans-intrinsic.c
index 7bcfda9..fac29c7 100644
--- a/trans-intrinsic.c
+++ b/trans-intrinsic.c
@@ -1315,20 +1315,6 @@ trans_num_images (gfc_se * se)
}
-static tree
-get_rank_from_desc (tree desc)
-{
- tree tmp;
- tree dtype;
-
- dtype = gfc_conv_descriptor_dtype (desc);
- tmp = build_int_cst (TREE_TYPE (dtype), GFC_DTYPE_RANK_MASK);
- tmp = fold_build2_loc (input_location, BIT_AND_EXPR, TREE_TYPE (dtype),
- dtype, tmp);
- return fold_convert (gfc_get_int_type (gfc_default_integer_kind), tmp);
-}
-
-
static void
gfc_conv_intrinsic_rank (gfc_se *se, gfc_expr *expr)
{
@@ -1345,7 +1331,7 @@ gfc_conv_intrinsic_rank (gfc_se *se, gfc_expr *expr)
gfc_add_block_to_block (&se->pre, &argse.pre);
gfc_add_block_to_block (&se->post, &argse.post);
- se->expr = get_rank_from_desc (argse.expr);
+ se->expr = gfc_conv_descriptor_rank (argse.expr);
}
@@ -1434,7 +1420,7 @@ gfc_conv_intrinsic_bound (gfc_se * se, gfc_expr * expr, int upper)
cond = fold_build2_loc (input_location, LT_EXPR, boolean_type_node,
bound, build_int_cst (TREE_TYPE (bound), 0));
if (as && as->type == AS_ASSUMED_RANK)
- tmp = get_rank_from_desc (desc);
+ tmp = gfc_conv_descriptor_rank (desc);
else
tmp = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (TREE_TYPE (desc))];
tmp = fold_build2_loc (input_location, GE_EXPR, boolean_type_node,
@@ -5895,7 +5881,7 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr)
gfc_conv_expr_lhs (&arg1se, arg1->expr);
if (arg1->expr->rank == -1)
{
- tmp = get_rank_from_desc (arg1se.expr);
+ tmp = gfc_conv_descriptor_rank (arg1se.expr);
tmp = fold_build2_loc (input_location, MINUS_EXPR,
TREE_TYPE (tmp), tmp, gfc_index_one_node);
}
The final patch needs adjustments in set_loop_bounds. I took the
opportunity to do some bugfixes in that area. Those are not absolutely
needed for {l,u}bound and shape support though.
The first hunk removes a n >= loop->dimen condition. Since the coarray
handling has been moved out of the scalarizer, this condition is always
false.
The second hunk is possibly more controversial and could be backed out
if that's preferred.
It changes the code so that it matches the comment before it. Namely, we
prefer having a loop specifier with strides of one . However, the code first
checks if the current boundspec is better than the one chosen so far
WRT strides, and if not falls back to check if there is an improvement
WRT lower bounds, but doesn't check that it doesn't make things worse
WRT strides. This second hunk adds the missing checks.
2012-08-02 Mikael Morin <mikael@gcc.gnu.org>
* trans-array.c (set_loop_bounds): Remove useless dimension check.
Don't update loopspec if it would lose the wanted stride criterium.
diff --git a/trans-array.c b/trans-array.c
index abdb9ea..feb35df 100644
--- a/trans-array.c
+++ b/trans-array.c
@@ -4469,8 +4469,7 @@ set_loop_bounds (gfc_loopinfo *loop)
known lower bound
known upper bound
*/
- else if ((loopspec[n]->info->type == GFC_SS_CONSTRUCTOR && dynamic[n])
- || n >= loop->dimen)
+ else if (loopspec[n]->info->type == GFC_SS_CONSTRUCTOR && dynamic[n])
loopspec[n] = ss;
else if (integer_onep (info->stride[dim])
&& !integer_onep (specinfo->stride[spec_dim]))
@@ -4479,7 +4478,11 @@ set_loop_bounds (gfc_loopinfo *loop)
&& !INTEGER_CST_P (specinfo->stride[spec_dim]))
loopspec[n] = ss;
else if (INTEGER_CST_P (info->start[dim])
- && !INTEGER_CST_P (specinfo->start[spec_dim]))
+ && !INTEGER_CST_P (specinfo->start[spec_dim])
+ && integer_onep (info->stride[dim])
+ == integer_onep (specinfo->stride[dim])
+ && INTEGER_CST_P (info->stride[dim])
+ == INTEGER_CST_P (specinfo->stride[dim]))
loopspec[n] = ss;
/* We don't work out the upper bound.
else if (INTEGER_CST_P (info->finish[n])
Another patch changing set_loop_bounds; this one (or at least a
variant of it) is really needed for {l,u}bound support.
We have some cases where there is nothing but an intrinsic specifying
the loop bounds (think of print *, ubound(assumed_rank)), so we need to
choose that loopspec in that case at least.
Previously the {l,u}bound and shape intrinsics had always a known shape,
and thus were automatically preferred for specifying the loop bounds.
Now if the shape is unknown we end up choosing no loopspec at all.
This patch allows non-array-sections to pass through the conditions
modified in the previous patch. It also removes a condition always
preferring function calls for the choice of loopspec. Both are made
under the assumption that the conditions modified in the previous patch
always make sense; not only for array section.
The patch could be made more conservative by adding an
intrinsic-specific bypass choosing the intrinsic boundspec only if there
is no other.
2012-08-02 Mikael Morin <mikael@gcc.gnu.org>
* trans-array.c (set_loop_bounds): Allow non-array-section to be
chosen using the stride and lower bound criteria.
diff --git a/trans-array.c b/trans-array.c
index feb35df..b799e24 100644
--- a/trans-array.c
+++ b/trans-array.c
@@ -4444,22 +4444,11 @@ set_loop_bounds (gfc_loopinfo *loop)
continue;
}
- /* TODO: Pick the best bound if we have a choice between a
- function and something else. */
- if (ss_type == GFC_SS_FUNCTION)
- {
- loopspec[n] = ss;
- continue;
- }
-
/* Avoid using an allocatable lhs in an assignment, since
there might be a reallocation coming. */
if (loopspec[n] && ss->is_alloc_lhs)
continue;
- if (ss_type != GFC_SS_SECTION)
- continue;
-
if (!loopspec[n])
loopspec[n] = ss;
/* Criteria for choosing a loop specifier (most important first):
This part finally uses the rank to setup the intrinsic boundspec in
gfc_conv_ss_startstride and uses the intrinsic boundspec to set the
upper bound in set_loop_bounds.
There is no additional code; with this the scalarizer is properly setup
and calls appropriately the code previously modified by Tobias to handle
the DIM= version of the {l,u}bound and shape intrinsics.
2012-08-02 Mikael Morin <mikael@gcc.gnu.org>
* trans-array.c (gfc_conv_ss_startstride): Set the intrinsic
result's lower and upper bounds according to the rank.
(set_loop_bounds): Set the loop upper bound in the intrinsic case.
diff --git a/trans-array.c b/trans-array.c
index b799e24..187eab0 100644
--- a/trans-array.c
+++ b/trans-array.c
@@ -3808,6 +3808,40 @@ done:
/* Fall through to supply start and stride. */
case GFC_ISYM_LBOUND:
case GFC_ISYM_UBOUND:
+ {
+ gfc_expr *arg;
+
+ /* This is the variant without DIM=... */
+ gcc_assert (expr->value.function.actual->next->expr == NULL);
+
+ arg = expr->value.function.actual->expr;
+ if (arg->rank == -1)
+ {
+ gfc_se se;
+ tree rank, tmp;
+
+ /* The rank (hence the return value's shape) is unknown,
+ we have to retrieve it. */
+ gfc_init_se (&se, NULL);
+ se.descriptor_only = 1;
+ gfc_conv_expr (&se, arg);
+ /* This is a bare variable, so there is no preliminary
+ or cleanup code. */
+ gcc_assert (se.pre.head == NULL_TREE
+ && se.post.head == NULL_TREE);
+ rank = gfc_conv_descriptor_rank (se.expr);
+ tmp = fold_build2_loc (input_location, MINUS_EXPR,
+ gfc_array_index_type,
+ fold_convert (gfc_array_index_type,
+ rank),
+ gfc_index_one_node);
+ info->end[0] = gfc_evaluate_now (tmp, &loop->pre);
+ info->start[0] = gfc_index_zero_node;
+ info->stride[0] = gfc_index_one_node;
+ continue;
+ }
+ /* Otherwise fall through GFC_SS_FUNCTION. */
+ }
case GFC_ISYM_LCOBOUND:
case GFC_ISYM_UCOBOUND:
case GFC_ISYM_THIS_IMAGE:
@@ -4526,6 +4560,20 @@ set_loop_bounds (gfc_loopinfo *loop)
gcc_assert (loop->to[n] == NULL_TREE);
break;
+ case GFC_SS_INTRINSIC:
+ {
+ gfc_expr *expr = loopspec[n]->info->expr;
+
+ /* The {l,u}bound of an assumed rank. */
+ gcc_assert ((expr->value.function.isym->id == GFC_ISYM_LBOUND
+ || expr->value.function.isym->id == GFC_ISYM_UBOUND)
+ && expr->value.function.actual->next->expr == NULL
+ && expr->value.function.actual->expr->rank == -1);
+
+ loop->to[n] = info->end[dim];
+ break;
+ }
+
default:
gcc_unreachable ();
}
! { dg-do run }
!
! Test the behaviour of lbound, ubound of shape with assumed rank arguments
! in an array context (without DIM argument).
!
program test
integer :: a(2:4,-2:5)
integer, allocatable :: b(:,:)
integer, pointer :: c(:,:)
character(52) :: buffer
call foo(a)
allocate(b(2:4,-2:5))
call foo(b)
call bar(b)
allocate(c(2:4,-2:5))
call foo(c)
call baz(c)
contains
subroutine foo(arg)
integer :: arg(..)
!print *, lbound(arg)
!print *, id(lbound(arg))
if (any(lbound(arg) /= [1, 1])) call abort
if (any(id(lbound(arg)) /= [1, 1])) call abort
buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
write(buffer,*) lbound(arg)
if (buffer /= ' 1 1') call abort
buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
write(buffer,*) id(lbound(arg))
if (buffer /= ' 1 1') call abort
!print *, ubound(arg)
!print *, id(ubound(arg))
if (any(ubound(arg) /= [3, 8])) call abort
if (any(id(ubound(arg)) /= [3, 8])) call abort
buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
write(buffer,*) ubound(arg)
if (buffer /= ' 3 8') call abort
buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
write(buffer,*) id(ubound(arg))
if (buffer /= ' 3 8') call abort
!print *, shape(arg)
!print *, id(shape(arg))
if (any(shape(arg) /= [3, 8])) call abort
if (any(id(shape(arg)) /= [3, 8])) call abort
buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
write(buffer,*) shape(arg)
if (buffer /= ' 3 8') call abort
buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
write(buffer,*) id(shape(arg))
if (buffer /= ' 3 8') call abort
end subroutine foo
subroutine bar(arg)
integer, allocatable :: arg(:,:)
!print *, lbound(arg)
!print *, id(lbound(arg))
if (any(lbound(arg) /= [2, -2])) call abort
if (any(id(lbound(arg)) /= [2, -2])) call abort
buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
write(buffer,*) lbound(arg)
if (buffer /= ' 2 -2') call abort
buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
write(buffer,*) id(lbound(arg))
if (buffer /= ' 2 -2') call abort
!print *, ubound(arg)
!print *, id(ubound(arg))
if (any(ubound(arg) /= [4, 5])) call abort
if (any(id(ubound(arg)) /= [4, 5])) call abort
buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
write(buffer,*) ubound(arg)
if (buffer /= ' 4 5') call abort
buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
write(buffer,*) id(ubound(arg))
if (buffer /= ' 4 5') call abort
!print *, shape(arg)
!print *, id(shape(arg))
if (any(shape(arg) /= [3, 8])) call abort
if (any(id(shape(arg)) /= [3, 8])) call abort
buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
write(buffer,*) shape(arg)
if (buffer /= ' 3 8') call abort
buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
write(buffer,*) id(shape(arg))
if (buffer /= ' 3 8') call abort
end subroutine bar
subroutine baz(arg)
integer, pointer :: arg(..)
!print *, lbound(arg)
!print *, id(lbound(arg))
if (any(lbound(arg) /= [2, -2])) call abort
if (any(id(lbound(arg)) /= [2, -2])) call abort
buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
write(buffer,*) lbound(arg)
if (buffer /= ' 2 -2') call abort
buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
write(buffer,*) id(lbound(arg))
if (buffer /= ' 2 -2') call abort
!print *, ubound(arg)
!print *, id(ubound(arg))
if (any(ubound(arg) /= [4, 5])) call abort
if (any(id(ubound(arg)) /= [4, 5])) call abort
buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
write(buffer,*) ubound(arg)
if (buffer /= ' 4 5') call abort
buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
write(buffer,*) id(ubound(arg))
if (buffer /= ' 4 5') call abort
!print *, shape(arg)
!print *, id(shape(arg))
if (any(shape(arg) /= [3, 8])) call abort
if (any(id(shape(arg)) /= [3, 8])) call abort
buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
write(buffer,*) shape(arg)
if (buffer /= ' 3 8') call abort
buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
write(buffer,*) id(shape(arg))
if (buffer /= ' 3 8') call abort
end subroutine baz
elemental function id(arg)
integer, intent(in) :: arg
integer :: id
id = arg
end function id
end program test
! { dg-do run }
!
! Test the behaviour of lbound, ubound of shape with assumed rank arguments
! in an array context (without DIM argument).
!
program test
integer :: a(2:4,-2:5)
integer, allocatable :: b(:,:)
integer, allocatable :: c(:,:)
integer, pointer :: d(:,:)
character(52) :: buffer
b = foo(a)
!print *,b(:,1)
if (any(b(:,1) /= [11, 101])) call abort
buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
write(buffer,*) b(:,1)
if (buffer /= ' 11 101') call abort
!print *,b(:,2)
if (any(b(:,2) /= [3, 8])) call abort
buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
write(buffer,*) b(:,2)
if (buffer /= ' 3 8') call abort
!print *,b(:,3)
if (any(b(:,3) /= [13, 108])) call abort
buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
write(buffer,*) b(:,3)
if (buffer /= ' 13 108') call abort
allocate(c(1:2,-3:6))
b = bar(c)
!print *,b(:,1)
if (any(b(:,1) /= [11, 97])) call abort
buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
write(buffer,*) b(:,1)
if (buffer /= ' 11 97') call abort
!print *,b(:,2)
if (any(b(:,2) /= [12, 106])) call abort
buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
write(buffer,*) b(:,2)
if (buffer /= ' 12 106') call abort
!print *,b(:,3)
if (any(b(:,3) /= [2, 10])) call abort
buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
write(buffer,*) b(:,3)
if (buffer /= ' 2 10') call abort
allocate(d(3:5,-1:10))
b = baz(d)
!print *,b(:,1)
if (any(b(:,1) /= [3, -1])) call abort
buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
write(buffer,*) b(:,1)
if (buffer /= ' 3 -1') call abort
!print *,b(:,2)
if (any(b(:,2) /= [15, 110])) call abort
buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
write(buffer,*) b(:,2)
if (buffer /= ' 15 110') call abort
!print *,b(:,3)
if (any(b(:,3) /= [13, 112])) call abort
buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
write(buffer,*) b(:,3)
if (buffer /= ' 13 112') call abort
contains
function foo(arg) result(res)
integer :: arg(..)
integer, allocatable :: res(:,:)
allocate(res(rank(arg), 3))
res(:,1) = lbound(arg) + (/ 10, 100 /)
res(:,2) = ubound(arg)
res(:,3) = (/ 10, 100 /) + shape(arg)
end function foo
function bar(arg) result(res)
integer, allocatable :: arg(..)
integer, allocatable :: res(:,:)
allocate(res(-1:rank(arg)-2, 3))
res(:,1) = lbound(arg) + (/ 10, 100 /)
res(:,2) = (/ 10, 100 /) + ubound(arg)
res(:,3) = shape(arg)
end function bar
function baz(arg) result(res)
integer, pointer :: arg(..)
integer, allocatable :: res(:,:)
allocate(res(2:rank(arg)+1, 3))
res(:,1) = lbound(arg)
res(:,2) = (/ 10, 100 /) + ubound(arg)
res(:,3) = shape(arg) + (/ 10, 100 /)
end function baz
end program test