diff mbox

[Fortran] PR 46100 - Allow pointer-function actuals in variable-definition contexts

Message ID 4CBF61DA.4090300@net-b.de
State New
Headers show

Commit Message

Tobias Burnus Oct. 20, 2010, 9:40 p.m. UTC 
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.

Comments

Mikael Morin Oct. 20, 2010, 11:04 p.m. UTC | #1 
On Wednesday 20 October 2010 23:40:42 Tobias Burnus wrote:
>   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?

OK. 
Thanks

Mikael
diff mbox

Patch

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
+