re PR fortran/48095 ([OOP] Invalid assignment to procedure pointer component not rejected)

2011-03-29  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/48095
	* decl.c (match_procedure_decl,match_ppc_decl): Set flavor of interface.
	* module.c (MOD_VERSION): Bump.
	(mio_typespec): Read/write 'interface' field.
	* primary.c (match_string_constant,match_logical_constant): Remove
	unneeded code.
	(match_complex_constant): Make sure to clear the typespec.

2011-03-29  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/48095
	* gfortran.dg/module_md5_1.f90: Modified MD5 sum.
	* gfortran.dg/proc_ptr_comp_32.f90: New.

From-SVN: r171654

gcc/fortran/ChangeLog

+2011-03-29  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/48095
+	* decl.c (match_procedure_decl,match_ppc_decl): Set flavor of interface.
+	* module.c (MOD_VERSION): Bump.
+	(mio_typespec): Read/write 'interface' field.
+	* primary.c (match_string_constant,match_logical_constant): Remove
+	unneeded code.
+	(match_complex_constant): Make sure to clear the typespec.
+
 2011-03-29  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
 	* frontend-passes.c (create_var):  Warn about creating an

gcc/fortran/decl.c

@@ -4737,8 +4737,9 @@ match_procedure_decl (void)
 	    return MATCH_ERROR;
 	  sym->ts.interface = gfc_new_symbol ("", gfc_current_ns);
 	  sym->ts.interface->ts = current_ts;
+	  sym->ts.interface->attr.flavor = FL_PROCEDURE;
 	  sym->ts.interface->attr.function = 1;
-	  sym->attr.function = sym->ts.interface->attr.function;
+	  sym->attr.function = 1;
 	  sym->attr.if_source = IFSRC_UNKNOWN;
 	}
 
@@ -4871,8 +4872,9 @@ match_ppc_decl (void)
 	  c->ts = ts;
 	  c->ts.interface = gfc_new_symbol ("", gfc_current_ns);
 	  c->ts.interface->ts = ts;
+	  c->ts.interface->attr.flavor = FL_PROCEDURE;
 	  c->ts.interface->attr.function = 1;
-	  c->attr.function = c->ts.interface->attr.function;
+	  c->attr.function = 1;
 	  c->attr.if_source = IFSRC_UNKNOWN;
 	}
 

gcc/fortran/module.c

@@ -80,7 +80,7 @@ along with GCC; see the file COPYING3.  If not see
 
 /* Don't put any single quote (') in MOD_VERSION, 
    if yout want it to be recognized.  */
-#define MOD_VERSION "6"
+#define MOD_VERSION "7"
 
 
 /* Structure that describes a position within a module file.  */
@@ -2124,6 +2124,8 @@ mio_typespec (gfc_typespec *ts)
   else
     mio_symbol_ref (&ts->u.derived);
 
+  mio_symbol_ref (&ts->interface);
+
   /* Add info for C interop and is_iso_c.  */
   mio_integer (&ts->is_c_interop);
   mio_integer (&ts->is_iso_c);

gcc/fortran/primary.c

@@ -980,9 +980,6 @@ got_delim:
     goto no_match;
 
   e = gfc_get_character_expr (kind, &start_locus, NULL, length);
-  e->ref = NULL;
-  e->ts.is_c_interop = 0;
-  e->ts.is_iso_c = 0;
 
   gfc_current_locus = start_locus;
 
@@ -1086,8 +1083,6 @@ match_logical_constant (gfc_expr **result)
     }
 
   e = gfc_get_logical_expr (kind, &gfc_current_locus, i);
-  e->ts.is_c_interop = 0;
-  e->ts.is_iso_c = 0;
 
   *result = e;
   return MATCH_YES;
@@ -1269,10 +1264,9 @@ match_complex_constant (gfc_expr **result)
       else
 	kind = gfc_default_real_kind;
     }
+  gfc_clear_ts (&target);
   target.type = BT_REAL;
   target.kind = kind;
-  target.is_c_interop = 0;
-  target.is_iso_c = 0;
 
   if (real->ts.type != BT_REAL || kind != real->ts.kind)
     gfc_convert_type (real, &target, 2);

gcc/testsuite/ChangeLog

+2011-03-29  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/48095
+	* gfortran.dg/module_md5_1.f90: Modified MD5 sum.
+	* gfortran.dg/proc_ptr_comp_32.f90: New.
+
 2011-03-29  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
 	* gfortran.dg/function_optimize_1.f90:  Add -Warray-temporaries,

gcc/testsuite/gfortran.dg/module_md5_1.f90

@@ -10,5 +10,5 @@ program test
   use foo
   print *, pi
 end program test
-! { dg-final { scan-module "foo" "MD5:5632bcd379cf023bf7e663e91d52fa12" } }
+! { dg-final { scan-module "foo" "MD5:12a205c48fe46315a609823f15986377" } }
 ! { dg-final { cleanup-modules "foo" } }

gcc/testsuite/gfortran.dg/proc_ptr_comp_32.f90

+! { dg-do compile }
+!
+! PR 48095: [OOP] Invalid assignment to procedure pointer component not rejected
+!
+! Contributed by Arjen Markus <arjen.markus895@gmail.com>
+
+module m
+
+  implicit none
+
+  type :: rectangle
+    procedure(get_area), pointer :: get_special_area
+  end type rectangle
+
+  abstract interface
+    real function get_area( this )
+      import                       :: rectangle
+      class(rectangle), intent(in) :: this
+    end function get_area
+  end interface
+
+contains
+
+  real function get_my_area( this )
+    type(rectangle), intent(in) :: this
+    get_my_area = 3.0
+  end function get_my_area
+
+end module
+
+
+use m
+type(rectangle) :: rect
+rect%get_special_area => get_my_area  ! { dg-error "Interface mismatch in procedure pointer assignment" }
+end
+
+! { dg-final { cleanup-modules "m" } }