This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[Patch, Fortran] PR 47377 reject nonpointer expr data-target in pointer assignment>
- From: Tobias Burnus <burnus at net-b dot de>
- To: gcc patches <gcc-patches at gcc dot gnu dot org>, gfortran <fortran at gcc dot gnu dot org>
- Date: Thu, 20 Jan 2011 23:01:06 +0100
- Subject: [Patch, Fortran] PR 47377 reject nonpointer expr data-target in pointer assignment>
A rather obvious patch for an ICE occurring for invalid code:
ptr => f()
requires that "f()" returns a pointer. Currently, gfortran first happily
accepts "f()" if the result variable has the target attribute - and then
it ICEs. (Cf. PR for the quotes from the standard.)
Build on x86-64-linux and currently regtesting (so far successfully).
OK for the trunk?
Tobias
2011-01-20 Tobias Burnus <burnus@net-b.de>
PR fortran/47377
* expr.c (gfc_check_pointer_assign): Reject expr data-targets
without pointer attribute.
2011-01-20 Tobias Burnus <burnus@net-b.de>
PR fortran/47377
* gfortran.dg/pointer_target_4.f90: New.
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 3f1141a..a4e48c8 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -3507,6 +3507,15 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue)
lvalue->symtree->n.sym->attr.subref_array_pointer = 1;
attr = gfc_expr_attr (rvalue);
+
+ if (rvalue->expr_type == EXPR_FUNCTION && !attr.pointer)
+ {
+ gfc_error ("Pointer assignment target expression "
+ "at %L must deliver a pointer result",
+ &rvalue->where);
+ return FAILURE;
+ }
+
if (!attr.target && !attr.pointer)
{
gfc_error ("Pointer assignment target is neither TARGET "
diff --git a/gcc/testsuite/gfortran.dg/pointer_target_4.f90 b/gcc/testsuite/gfortran.dg/pointer_target_4.f90
new file mode 100644
index 0000000..cda3453
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pointer_target_4.f90
@@ -0,0 +1,15 @@
+! { dg-do compile }
+!
+! PR fortran/47377
+!
+! Contributed by <thenlich@users.sourceforge.net>
+!
+program testgferr
+ real, pointer :: y
+ y => f() ! { dg-error "must deliver a pointer result" }
+contains
+ function f()
+ real :: f
+ f = 5
+ end function f
+end program testgferr