re PR fortran/42188 ([OOP] F03:C612. The leftmost part-name shall be the name of a data object.)

2016-12-03  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/42188
	* primary.c (gfc_match_rvalue): Add a new check that gives better error
	messages.

2016-12-03  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/42188
	* gfortran.dg/derived_result_2.f90.f90: New test case.

From-SVN: r243223

gcc/fortran/ChangeLog

 2016-12-03  Janus Weil  <janus@gcc.gnu.org>
 
+	PR fortran/42188
+	* primary.c (gfc_match_rvalue): Add a new check that gives better error
+	messages.
+
+2016-12-03  Janus Weil  <janus@gcc.gnu.org>
+
 	PR fortran/58175
 	* resolve.c (gfc_resolve_finalizers): Prevent bogus warning.
 

gcc/fortran/primary.c

@@ -3298,6 +3298,15 @@ gfc_match_rvalue (gfc_expr **result)
       if (sym->result == NULL)
 	sym->result = sym;
 
+      gfc_gobble_whitespace ();
+      /* F08:C612.  */
+      if (gfc_peek_ascii_char() == '%')
+	{
+	  gfc_error ("The leftmost part-ref in a data-ref can not be a "
+		     "function reference at %C");
+	  m = MATCH_ERROR;
+	}
+
       m = MATCH_YES;
       break;
 

gcc/testsuite/ChangeLog

 2016-12-03  Janus Weil  <janus@gcc.gnu.org>
 
+	PR fortran/42188
+	* gfortran.dg/derived_result_2.f90.f90: New test case.
+
+2016-12-03  Janus Weil  <janus@gcc.gnu.org>
+
 	PR fortran/58175
 	* gfortran.dg/finalize_30.f90: Extend test case.
 

gcc/testsuite/gfortran.dg/derived_result_2.f90

+! { dg-do compile }
+!
+! PR 42188: [OOP] F03:C612. The leftmost part-name shall be the name of a data object
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+module grid_module
+ implicit none
+ type grid
+ contains
+   procedure :: new_grid
+   procedure :: new_int
+ end type
+contains
+ subroutine new_grid(this)
+   class(grid) :: this
+ end subroutine
+ integer function new_int(this)
+   class(grid) :: this
+   new_int = 42
+ end function
+end module
+
+module field_module
+ use grid_module
+ implicit none
+
+ type field
+   type(grid) :: mesh
+ end type
+
+contains
+
+ type(field) function new_field()
+ end function
+
+ subroutine test
+   integer :: i
+   type(grid) :: g
+   g = new_field()%mesh              ! { dg-error "can not be a function reference" }
+   call new_field()%mesh%new_grid()  ! { dg-error "Syntax error" }
+   i = new_field() % mesh%new_int()  ! { dg-error "can not be a function reference" }
+ end subroutine
+
+end module