This is the mail archive of the fortran@gcc.gnu.org mailing list for the GNU Fortran project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[Patch, fortran] PR34910 - [4.2/4.3 Regression] ICE on invalid assignments in doubly-contained functions


:ADDPATCH fortran:

This is a bit of low lying fruit - Daniel had essentially identified
the solution in the PR!

At the moment, it is only regtested on Cygwin - I'll do the full
business tonight before committing.

OK for trunk?

Paul

2008-01-31  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/34910
	* expr.c (gfc_check_assign): It is an error to assign
	to a sibling procedure.

2008-01-31  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/34910
	* gfortran.dg/proc_assign_2.f90: New test.
Index: gcc/fortran/expr.c
===================================================================
*** gcc/fortran/expr.c	(revision 131741)
--- gcc/fortran/expr.c	(working copy)
*************** gfc_check_assign (gfc_expr *lvalue, gfc_
*** 2705,2710 ****
--- 2705,2719 ----
  	    bad_proc = true;
  	}
  
+       /* (iv) Host associated and not the function symbol or the
+ 	      parent result.  This picks up sibling references, which
+ 	      cannot be entries.  */
+       if (!sym->attr.entry
+ 	    && sym->ns == gfc_current_ns->parent
+ 	    && sym != gfc_current_ns->proc_name
+ 	    && sym != gfc_current_ns->parent->proc_name->result)
+ 	bad_proc = true;
+ 
        if (bad_proc)
  	{
  	  gfc_error ("'%s' at %L is not a VALUE", sym->name, &lvalue->where);
Index: gcc/testsuite/gfortran.dg/proc_assign_2.f90
===================================================================
*** gcc/testsuite/gfortran.dg/proc_assign_2.f90	(revision 0)
--- gcc/testsuite/gfortran.dg/proc_assign_2.f90	(revision 0)
***************
*** 0 ****
--- 1,21 ----
+ ! { dg-do compile }
+ ! This checks the fix for PR34910, in which the invalid reference
+ ! below caused an ICE.
+ !
+ ! Contributed by Daniel Franke <dfranke@gcc.gnu.org>
+ !
+ MODULE foo
+ CONTAINS
+   INTEGER FUNCTION f()
+   f = 42
+   CONTAINS
+     LOGICAL FUNCTION f1()
+       f1 = .TRUE.
+     END FUNCTION
+ 
+     LOGICAL FUNCTION f2()
+       f1 = .FALSE.  ! { gfc-error "not a VALUE" }
+     END FUNCTION
+   END FUNCTION
+ END MODULE
+ ! { dg-final { cleanup-modules "foo" } }

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]