From: Mikael Morin <mikael@gcc.gnu.org>
Date: Sun, 24 May 2015 14:55:50 +0000 (+0000)
Subject: re PR fortran/66257 (ELEMENTAL procedure pointer component XX is not allowed as an... 
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=bc0c7f396b0c9648365aee462e25107db00227e8;p=gcc.git

re PR fortran/66257 (ELEMENTAL procedure pointer component XX is not allowed as an actual argument)

	PR fortran/66257
gcc/fortran/
	* resolve.c (resolve_actual_arglist): Don't throw an error
	if the argument with procedure pointer component is not a variable.
gcc/testsuite/
	* typebound_call_27.f90: New file.

From-SVN: r223631
---

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 420a99d7788..bc623c4dbde 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2015-05-24  Mikael Morin  <mikael@gcc.gnu.org>
+
+	PR fortran/66257
+	* resolve.c (resolve_actual_arglist): Don't throw an error
+	if the argument with procedure pointer component is not a variable.
+
 2015-05-24  Manuel López-Ibáñez  <manu@gcc.gnu.org>
 
 	PR fortran/44054
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 492c016ad9c..e615cc6dfb2 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -1981,7 +1981,8 @@ resolve_actual_arglist (gfc_actual_arglist *arg, procedure_type ptype,
 	}
 
       comp = gfc_get_proc_ptr_comp(e);
-      if (comp && comp->attr.elemental)
+      if (e->expr_type == EXPR_VARIABLE
+	  && comp && comp->attr.elemental)
 	{
 	    gfc_error ("ELEMENTAL procedure pointer component %qs is not "
 		       "allowed as an actual argument at %L", comp->name,
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index e302f01257a..41a478d4dea 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2015-05-24  Mikael Morin  <mikael@gcc.gnu.org>
+
+	PR fortran/66257
+	* typebound_call_27.f90: New file.
+
 2015-05-23  Nathan Sidwell  <nathan@acm.org>
 
 	PR c++/65936
diff --git a/gcc/testsuite/gfortran.dg/typebound_call_27.f90 b/gcc/testsuite/gfortran.dg/typebound_call_27.f90
new file mode 100644
index 00000000000..f183ebb7155
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_call_27.f90
@@ -0,0 +1,41 @@
+! { dg-do compile }
+!
+! PR fortran/66257
+! Check that typebound function calls are accepted as actual argument.
+!
+MODULE test_class
+  IMPLICIT NONE
+  PRIVATE
+  PUBLIC:: test
+
+  INTEGER, PARAMETER :: dp  = SELECTED_REAL_KIND(15)
+
+  TYPE test
+      PRIVATE
+      CONTAINS
+          PRIVATE
+              PROCEDURE, PUBLIC:: E
+              PROCEDURE, PUBLIC:: Om
+  END TYPE test
+
+CONTAINS
+
+  ELEMENTAL FUNCTION E (self, a)
+    IMPLICIT NONE
+    CLASS(test), INTENT(IN):: self
+    REAL(kind=dp), INTENT(IN):: a
+    REAL(kind=dp):: E
+
+    E = a
+  END FUNCTION E
+
+  ELEMENTAL FUNCTION Om (self, z)
+    IMPLICIT NONE
+    CLASS(test), INTENT(IN):: self
+    REAL(kind=dp), INTENT(IN):: z
+    REAL(kind=dp):: Om
+
+    Om = self%E(self%E(z))
+    Om = log10(self%E(z))
+  END FUNCTION Om
+END MODULE test_class