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

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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 4bb344d..3ebca54 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,13 @@
+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

diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 8b5f92b..f7a704f 100644 (file)
--- a/gcc/fortran/decl.c
+++ b/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;
        }
 

diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index 923f8c6..36701b4 100644 (file)
--- a/gcc/fortran/module.c
+++ b/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);

diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c
index 4cda7a1..a121999 100644 (file)
--- a/gcc/fortran/primary.c
+++ b/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);

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 071f959..6b960a6 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+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,

diff --git a/gcc/testsuite/gfortran.dg/module_md5_1.f90 b/gcc/testsuite/gfortran.dg/module_md5_1.f90
index e725b4b..f146cd2 100644 (file)
--- a/gcc/testsuite/gfortran.dg/module_md5_1.f90
+++ b/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" } }

diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_comp_32.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_comp_32.f90
new file mode 100644 (file)
index 0000000..eda972a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_comp_32.f90
@@ -0,0 +1,37 @@
+! { 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" } }