From: Janus Weil <janus@gcc.gnu.org>
Date: Thu, 3 Jan 2013 16:14:54 +0000 (+0100)
Subject: re PR fortran/55855 ([OOP] incorrect warning with procedure pointer component on... 
X-Git-Tag: releases/gcc-4.8.0~1146
X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=8988cde62b4b1edc8fa6cdee6e02b09c6c9f15d4;p=thirdparty%2Fgcc.git

re PR fortran/55855 ([OOP] incorrect warning with procedure pointer component on pointer-valued base object)

2013-01-03  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/55855
	* expr.c (gfc_check_assign): Use 'gfc_expr_attr' to evaluate attributes
	of rvalue. Correct hyphenation in error message.

2013-01-03  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/55855
	* gfortran.dg/assignment_1.f90: Modified.
	* gfortran.dg/assignment_4.f90: New.

From-SVN: r194857
---

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 1fc88f22e070..2b050b12d7f8 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2013-01-03  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/55855
+	* expr.c (gfc_check_assign): Use 'gfc_expr_attr' to evaluate attributes
+	of rvalue. Correct hyphenation in error message.
+
 2013-01-03  Jakub Jelinek  <jakub@redhat.com>
 
 	* gfortranspec.c (lang_specific_driver): Update copyright notice
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 5c9ce11c4eec..261078460d25 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -3151,9 +3151,8 @@ gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue, int conform)
 
   /* This is possibly a typo: x = f() instead of x => f().  */
   if (gfc_option.warn_surprising
-      && rvalue->expr_type == EXPR_FUNCTION
-      && rvalue->symtree->n.sym->attr.pointer)
-    gfc_warning ("POINTER valued function appears on right-hand side of "
+      && rvalue->expr_type == EXPR_FUNCTION && gfc_expr_attr (rvalue).pointer)
+    gfc_warning ("POINTER-valued function appears on right-hand side of "
 		 "assignment at %L", &rvalue->where);
 
   /* Check size of array assignments.  */
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 36383ad29f78..234eeaceedd4 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2013-01-03  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/55855
+	* gfortran.dg/assignment_1.f90: Modified.
+	* gfortran.dg/assignment_4.f90: New.
+
 2013-01-03  David Edelsohn  <dje.gcc@gmail.com>
 
 	* gcc.dg/torture/tls/tls-reload-1.c: Add tls options.
diff --git a/gcc/testsuite/gfortran.dg/assignment_1.f90 b/gcc/testsuite/gfortran.dg/assignment_1.f90
index c8018a3d4c3c..4322e5934c01 100644
--- a/gcc/testsuite/gfortran.dg/assignment_1.f90
+++ b/gcc/testsuite/gfortran.dg/assignment_1.f90
@@ -12,7 +12,7 @@ integer, target :: t, s
 t = 1
 p => s
 ! We didn't dereference the pointer in the following line.
-p = f() ! { dg-warning "POINTER valued function" "" }
+p = f() ! { dg-warning "POINTER-valued function" "" }
 p = p+1
 if (p.ne.2) call abort()
 if (p.ne.s) call abort()
diff --git a/gcc/testsuite/gfortran.dg/assignment_4.f90 b/gcc/testsuite/gfortran.dg/assignment_4.f90
new file mode 100644
index 000000000000..77181a2054ef
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/assignment_4.f90
@@ -0,0 +1,16 @@
+! { dg-do compile }
+! { dg-options "-Wall" }
+!
+! PR 55855: [OOP] incorrect warning with procedure pointer component on pointer-valued base object
+!
+! Contributed by Andrew Benson <abensonca@gmail.com>
+
+  implicit none
+  type :: event
+    procedure(logical), pointer, nopass :: task
+  end type event
+  logical :: r
+  type(event), pointer :: myEvent
+  allocate(myEvent)
+  r=myEvent%task()
+end