This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[Patch, Fortran] PR 46100 - Allow pointer-function actuals in variable-definition contexts
- 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: Wed, 20 Oct 2010 23:40:42 +0200
- Subject: [Patch, Fortran] PR 46100 - Allow pointer-function actuals in variable-definition contexts
In Fortran 2008, a pointer-function expression counts as variable.
Thus, for a pointer-function "f()" and a procedure "sub" with has a
nonpointer dummy, one can use
call two (f())
even if the dummy argument of "sub" is used in a variable-definition
context.
Build and regtested on x86-64-linux.
OK for the trunk?
Tobias
PS: F2008 also allows, e.g. "f() = 7" - but that's not yet supported by
gfortran.
2010-10-20 Tobias Burnus <burnus@net-b.de>
PR fortran/46100
* expr.c (gfc_check_vardef_context): Treat pointer functions
as variables.
2010-10-20 Tobias Burnus <burnus@net-b.de>
PR fortran/46100
* gfortran.dg/ptr-func-1.f90: New.
* gfortran.dg/ptr-func-2.f90: New.
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 5711634..ef516a4 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -4316,7 +4316,18 @@ gfc_check_vardef_context (gfc_expr* e, bool pointer, const char* context)
symbol_attribute attr;
gfc_ref* ref;
- if (e->expr_type != EXPR_VARIABLE)
+ if (!pointer && e->expr_type == EXPR_FUNCTION
+ && e->symtree->n.sym->result->attr.pointer)
+ {
+ if (!(gfc_option.allow_std & GFC_STD_F2008))
+ {
+ if (context)
+ gfc_error ("Fortran 2008: Pointer functions in variable definition"
+ " context (%s) at %L", context, &e->where);
+ return FAILURE;
+ }
+ }
+ else if (e->expr_type != EXPR_VARIABLE)
{
if (context)
gfc_error ("Non-variable expression in variable definition context (%s)"
diff --git a/gcc/testsuite/gfortran.dg/ptr-func-1.f90 b/gcc/testsuite/gfortran.dg/ptr-func-1.f90
new file mode 100644
index 0000000..b7c1fc9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/ptr-func-1.f90
@@ -0,0 +1,24 @@
+! { dg-do compile }
+! { dg-options "-std=f2008 -fall-intrinsics" }
+!
+! PR fortran/46100
+!
+! Pointer function as definable actual argument
+! - a Fortran 2008 feature
+!
+integer, target :: tgt
+call one (two ())
+if (tgt /= 774) call abort ()
+contains
+ subroutine one (x)
+ integer, intent(inout) :: x
+ if (x /= 34) call abort ()
+ x = 774
+ end subroutine one
+ function two ()
+ integer, pointer :: two
+ two => tgt
+ two = 34
+ end function two
+end
+
diff --git a/gcc/testsuite/gfortran.dg/ptr-func-2.f90 b/gcc/testsuite/gfortran.dg/ptr-func-2.f90
new file mode 100644
index 0000000..8275f14
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/ptr-func-2.f90
@@ -0,0 +1,24 @@
+! { dg-do compile }
+! { dg-options "-std=f2003 -fall-intrinsics" }
+!
+! PR fortran/46100
+!
+! Pointer function as definable actual argument
+! - a Fortran 2008 feature
+!
+integer, target :: tgt
+call one (two ()) ! { dg-error "Fortran 2008: Pointer functions" }
+if (tgt /= 774) call abort ()
+contains
+ subroutine one (x)
+ integer, intent(inout) :: x
+ if (x /= 34) call abort ()
+ x = 774
+ end subroutine one
+ function two ()
+ integer, pointer :: two
+ two => tgt
+ two = 34
+ end function two
+end
+