diff options
| -rw-r--r-- | gcc/fortran/ChangeLog | 7 | ||||
| -rw-r--r-- | gcc/fortran/intrinsic.c | 3 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/c_assoc_5.f90 | 69 |
4 files changed, 83 insertions, 1 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 8baf108..34719a1 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2013-04-16 Tobias Burnus <burnus@net-b.de> + + PR fortran/56969 + * intrinsic.c (gfc_intrinsic_func_interface): Don't set + module name to "(intrinsic)" for intrinsics from intrinsic + modules. + 2013-04-15 Tobias Burnus <burnus@net-b.de> * intrinsic.texi (SYSTEM_CLOCK): Recommend kind=8. diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c index c431279..688332f 100644 --- a/gcc/fortran/intrinsic.c +++ b/gcc/fortran/intrinsic.c @@ -4236,7 +4236,8 @@ gfc_intrinsic_func_interface (gfc_expr *expr, int error_flag) got_specific: expr->value.function.isym = specific; - gfc_intrinsic_symbol (expr->symtree->n.sym); + if (!expr->symtree->n.sym->module) + gfc_intrinsic_symbol (expr->symtree->n.sym); if (!error_flag) gfc_pop_suppress_errors (); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 1d7c65b..deb85a7 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2013-04-16 Tobias Burnus <burnus@net-b.de> + + PR fortran/56969 + * gfortran.dg/c_assoc_5.f90: New. + 2013-04-16 Uros Bizjak <ubizjak@gmail.com> * g++.dg/ipa/devirt-c-7.C: Require nonpic effective target. diff --git a/gcc/testsuite/gfortran.dg/c_assoc_5.f90 b/gcc/testsuite/gfortran.dg/c_assoc_5.f90 new file mode 100644 index 0000000..105b8f8 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/c_assoc_5.f90 @@ -0,0 +1,69 @@ +! { dg-do compile } +! +! PR fortran/56969 +! +! Contributed by Salvatore Filippone +! +! Was before rejected as the different c_associated weren't recognized to +! come from the same module. +! +module test_mod + use iso_c_binding + + type(c_ptr), save :: test_context = c_null_ptr + + type, bind(c) :: s_Cmat + type(c_ptr) :: Mat = c_null_ptr + end type s_Cmat + + + interface + function FtestCreate(context) & + & bind(c,name="FtestCreate") result(res) + use iso_c_binding + type(c_ptr) :: context + integer(c_int) :: res + end function FtestCreate + end interface +contains + + function initFtest() result(res) + implicit none + integer(c_int) :: res + if (c_associated(test_context)) then + res = 0 + else + res = FtestCreate(test_context) + end if + end function initFtest +end module test_mod + +module base_mat_mod + type base_sparse_mat + integer, allocatable :: ia(:) + end type base_sparse_mat +end module base_mat_mod + +module extd_mat_mod + + use iso_c_binding + use test_mod + use base_mat_mod + + type, extends(base_sparse_mat) :: extd_sparse_mat + type(s_Cmat) :: deviceMat + end type extd_sparse_mat + +end module extd_mat_mod + +subroutine extd_foo(a) + + use extd_mat_mod + implicit none + class(extd_sparse_mat), intent(inout) :: a + + if (c_associated(a%deviceMat%Mat)) then + write(*,*) 'C Associated' + end if + +end subroutine extd_foo |