Hi all,
the attached patch fixes a problem with assignments to procedure
pointer components: The checking for such assignments did only work
within one module, but not across modules. The reason for this was
that the "ts.interface" field was not being written to the module
file.
The patch fixes this by writing the field to the mod file. It also
bumps the module version number and takes care of a few regression
introduced by the former change. It fixes comment #3 in the PR, which
is included as a test case. There is a remaining problem in the PR
(related the pointer initialization) which I will take care of
subsequently.
The patch was regtested on x86_64-unknown-linux-gnu. Ok for trunk?
Cheers,
Janus
2011-03-28 Janus Weil <ja...@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-28 Janus Weil <ja...@gcc.gnu.org>
PR fortran/48095
* gfortran.dg/module_md5_1.f90: Modified MD5 sum.
* gfortran.dg/proc_ptr_comp_32.f90: New.
Index: gcc/testsuite/gfortran.dg/module_md5_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/module_md5_1.f90 (revision 171617)
+++ gcc/testsuite/gfortran.dg/module_md5_1.f90 (working copy)
@@ -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" } }
Index: gcc/fortran/decl.c
===================================================================
--- gcc/fortran/decl.c (revision 171617)
+++ gcc/fortran/decl.c (working copy)
@@ -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;
}
Index: gcc/fortran/module.c
===================================================================
--- gcc/fortran/module.c (revision 171617)
+++ gcc/fortran/module.c (working copy)
@@ -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);
Index: gcc/fortran/primary.c
===================================================================
--- gcc/fortran/primary.c (revision 171617)
+++ gcc/fortran/primary.c (working copy)
@@ -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);
! { dg-do compile }
!
! PR 48095: [OOP] Invalid assignment to procedure pointer component not rejected
!
! Contributed by Arjen Markus <arjen.markus...@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" } }
