aboutsummaryrefslogtreecommitdiff
path: root/gcc/fortran
diff options
context:
space:
mode:
authorThomas König <tkoenig@gcc.gnu.org>2020-04-23 20:30:01 +0200
committerThomas König <tkoenig@gcc.gnu.org>2020-04-23 20:30:01 +0200
commit06eca1acafa27e19e82dc73927394a7a4d0bdbc5 (patch)
tree4c1c6756bd17f5900f4ee9ff8d9386336cae1533 /gcc/fortran
parentdcf69ac5448fd6a16137cfe9fe6deadd0ec0243d (diff)
downloadgcc-06eca1acafa27e19e82dc73927394a7a4d0bdbc5.zip
gcc-06eca1acafa27e19e82dc73927394a7a4d0bdbc5.tar.gz
gcc-06eca1acafa27e19e82dc73927394a7a4d0bdbc5.tar.bz2
Fix PR 93956, wrong pointer when returned via function.
This one took a bit of detective work. When array pointers point to components of derived types, we currently set the span field and then create an array temporary when we pass the array pointer to a procedure as a non-pointer or non-target argument. (This is inefficient, but that's for another release). Now, the compiler detected this case when there was a direct assignment like p => a%b, but not when p was returned either as a function result or via an argument. This patch fixes that. 2020-04-23 Thomas Koenig <tkoenig@gcc.gnu.org> PR fortran/93956 * expr.c (gfc_check_pointer_assign): Also set subref_array_pointer when a function returns a pointer. * interface.c (gfc_set_subref_array_pointer_arg): New function. (gfc_procedure_use): Call it. 2020-04-23 Thomas Koenig <tkoenig@gcc.gnu.org> PR fortran/93956 * gfortran.dg/pointer_assign_13.f90: New test.
Diffstat (limited to 'gcc/fortran')
-rw-r--r--gcc/fortran/ChangeLog8
-rw-r--r--gcc/fortran/expr.c7
-rw-r--r--gcc/fortran/interface.c34
3 files changed, 47 insertions, 2 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 9d06c2e..2274ce0 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+2020-04-23 Thomas Koenig <tkoenig@gcc.gnu.org>
+
+ PR fortran/93956
+ * expr.c (gfc_check_pointer_assign): Also set subref_array_pointer
+ when a function returns a pointer.
+ * interface.c (gfc_set_subref_array_pointer_arg): New function.
+ (gfc_procedure_use): Call it.
+
2020-04-22 Fritz Reese <foreese@gcc.gnu.org>
* trigd_fe.inc: Use mpfr to compute cosd(30) rather than a host-
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index a9fa03a..618c98a 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -4242,8 +4242,11 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue,
if (rvalue->expr_type == EXPR_NULL)
return true;
- if (rvalue->expr_type == EXPR_VARIABLE && is_subref_array (rvalue))
- lvalue->symtree->n.sym->attr.subref_array_pointer = 1;
+ /* A function may also return subref arrray pointer. */
+
+ if ((rvalue->expr_type == EXPR_VARIABLE && is_subref_array (rvalue))
+ || rvalue->expr_type == EXPR_FUNCTION)
+ lvalue->symtree->n.sym->attr.subref_array_pointer = 1;
attr = gfc_expr_attr (rvalue);
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index ba1c8bc..58b7abf 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -3788,6 +3788,36 @@ check_intents (gfc_formal_arglist *f, gfc_actual_arglist *a)
return true;
}
+/* Go through the argument list of a procedure and look for
+ pointers which may be set, possibly introducing a span. */
+
+static void
+gfc_set_subref_array_pointer_arg (gfc_formal_arglist *dummy_args,
+ gfc_actual_arglist *actual_args)
+{
+ gfc_formal_arglist *f;
+ gfc_actual_arglist *a;
+ gfc_symbol *a_sym;
+ for (f = dummy_args, a = actual_args; f && a ; f = f->next, a = a->next)
+ {
+
+ if (f->sym == NULL)
+ continue;
+
+ if (!f->sym->attr.pointer || f->sym->attr.intent == INTENT_IN)
+ continue;
+
+ if (a->expr == NULL || a->expr->expr_type != EXPR_VARIABLE)
+ continue;
+ a_sym = a->expr->symtree->n.sym;
+
+ if (!a_sym->attr.pointer)
+ continue;
+
+ a_sym->attr.subref_array_pointer = 1;
+ }
+ return;
+}
/* Check how a procedure is used against its interface. If all goes
well, the actual argument list will also end up being properly
@@ -3968,6 +3998,10 @@ gfc_procedure_use (gfc_symbol *sym, gfc_actual_arglist **ap, locus *where)
if (warn_aliasing)
check_some_aliasing (dummy_args, *ap);
+ /* Set the subref_array_pointer_arg if needed. */
+ if (dummy_args)
+ gfc_set_subref_array_pointer_arg (dummy_args, *ap);
+
return true;
}