From 9dc3595654f0dfbf2821d0a84972d9c1df01b311 Mon Sep 17 00:00:00 2001 From: "Christopher D. Rickett" Date: Tue, 11 Sep 2007 17:53:22 +0200 Subject: [PATCH] re PR fortran/33040 ([ISO_C_BINDING] ICE in gfc_trans_structure_assign) 2007-09-11 Christopher D. Rickett PR fortran/33040 * trans-expr.c (gfc_trans_structure_assign): Convert component C_NULL_PTR and C_NULL_FUNPTR component initializers to (void *). * trans-types.c (gfc_get_derived_type): Create a backend_decl for the c_address field of C_PTR and C_FUNPTR and ensure initializer is of proper type/kind for (void *). 2007-09-11 Christopher D. Rickett PR fortran/33040 * gfortran.dg/c_ptr_tests_11.f03: New test case. From-SVN: r128385 --- gcc/fortran/ChangeLog | 9 +++++ gcc/fortran/trans-expr.c | 13 ++++++ gcc/fortran/trans-types.c | 20 ++++++++++ gcc/testsuite/ChangeLog | 17 +++++--- gcc/testsuite/gfortran.dg/c_ptr_tests_11.f03 | 42 ++++++++++++++++++++ 5 files changed, 95 insertions(+), 6 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/c_ptr_tests_11.f03 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 348d2b064bf..99c13c6a162 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,12 @@ +2007-09-11 Christopher D. Rickett + + PR fortran/33040 + * trans-expr.c (gfc_trans_structure_assign): Convert component + C_NULL_PTR and C_NULL_FUNPTR component initializers to (void *). + * trans-types.c (gfc_get_derived_type): Create a backend_decl for + the c_address field of C_PTR and C_FUNPTR and ensure initializer + is of proper type/kind for (void *). + 2007-09-11 Jan Hubicka * f95-lang.c (gfc_expand_function): Kill. diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 411109287ce..1a4f42443df 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -3155,6 +3155,19 @@ gfc_trans_structure_assign (tree dest, gfc_expr * expr) if (!c->expr) continue; + /* Update the type/kind of the expression if it represents either + C_NULL_PTR or C_NULL_FUNPTR. This is done here because this may + be the first place reached for initializing output variables that + have components of type C_PTR/C_FUNPTR that are initialized. */ + if (c->expr->ts.type == BT_DERIVED && c->expr->ts.derived + && c->expr->ts.derived->attr.is_iso_c) + { + c->expr->expr_type = EXPR_NULL; + c->expr->ts.type = c->expr->ts.derived->ts.type; + c->expr->ts.f90_type = c->expr->ts.derived->ts.f90_type; + c->expr->ts.kind = c->expr->ts.derived->ts.kind; + } + field = cm->backend_decl; tmp = build3 (COMPONENT_REF, TREE_TYPE (field), dest, field, NULL_TREE); tmp = gfc_trans_subcomponent_assign (tmp, cm, c->expr); diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c index b7c9c53bf21..ba72466372c 100644 --- a/gcc/fortran/trans-types.c +++ b/gcc/fortran/trans-types.c @@ -1688,16 +1688,29 @@ gfc_get_derived_type (gfc_symbol * derived) /* See if it's one of the iso_c_binding derived types. */ if (derived->attr.is_iso_c == 1) { + if (derived->backend_decl) + return derived->backend_decl; + if (derived->intmod_sym_id == ISOCBINDING_PTR) derived->backend_decl = ptr_type_node; else derived->backend_decl = pfunc_type_node; + + /* Create a backend_decl for the __c_ptr_c_address field. */ + derived->components->backend_decl = + gfc_add_field_to_struct (&(derived->backend_decl->type.values), + derived->backend_decl, + get_identifier (derived->components->name), + gfc_typenode_for_spec ( + &(derived->components->ts))); + derived->ts.kind = gfc_index_integer_kind; derived->ts.type = BT_INTEGER; /* Set the f90_type to BT_VOID as a way to recognize something of type BT_INTEGER that needs to fit a void * for the purpose of the iso_c_binding derived types. */ derived->ts.f90_type = BT_VOID; + return derived->backend_decl; } @@ -1742,6 +1755,13 @@ gfc_get_derived_type (gfc_symbol * derived) c->ts.type = c->ts.derived->ts.type; c->ts.kind = c->ts.derived->ts.kind; c->ts.f90_type = c->ts.derived->ts.f90_type; + if (c->initializer) + { + c->initializer->ts.type = c->ts.type; + c->initializer->ts.kind = c->ts.kind; + c->initializer->ts.f90_type = c->ts.f90_type; + c->initializer->expr_type = EXPR_NULL; + } } } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 953e6aab619..c1d37557e45 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2007-09-11 Christopher D. Rickett + + PR fortran/33040 + * gfortran.dg/c_ptr_tests_11.f03: New test case. + 2007-09-11 Jakub Jelinek * gcc.dg/va-arg-pack-len-1.c: New test. @@ -25,15 +30,15 @@ 2007-09-10 Harsha Jagasia - * gcc.dg/vect/costmodel/i386/costmodel-vect-31.c: + * gcc.dg/vect/costmodel/i386/costmodel-vect-31.c: Change dg-final to expect 1 non-profitable loop and 3 profitable loops. - * gcc.dg/vect/costmodel/x86-64/costmodel-vect-31.c: + * gcc.dg/vect/costmodel/x86-64/costmodel-vect-31.c: Change dg-final to expect 1 non-profitable loop and 3 profitable loops. - * gcc.dg/vect/costmodel/x86-64/costmodel-fast-math-vect-pr29925.c: + * gcc.dg/vect/costmodel/x86-64/costmodel-fast-math-vect-pr29925.c: Change dg-final to expect 1 profitable loop. - * gcc.dg/vect/costmodel/i386/costmodel-fast-math-vect-pr29925.c: + * gcc.dg/vect/costmodel/i386/costmodel-fast-math-vect-pr29925.c: Change dg-final to expect 1 profitable loop. 2007-09-10 Richard Sandiford @@ -345,7 +350,7 @@ 2007-09-05 Sandra Loosemore David Ung - Nigel Stephens + Nigel Stephens * gcc.c-torture/compile/mipscop-1.c: Add nomips16 attributes. * gcc.c-torture/compile/mipscop-2.c: Likewise. @@ -378,7 +383,7 @@ 2007-09-05 Sandra Loosemore David Ung - Nigel Stephens + Nigel Stephens * gcc.target/mips/mips16-attributes.c: New. diff --git a/gcc/testsuite/gfortran.dg/c_ptr_tests_11.f03 b/gcc/testsuite/gfortran.dg/c_ptr_tests_11.f03 new file mode 100644 index 00000000000..9448f82ba82 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/c_ptr_tests_11.f03 @@ -0,0 +1,42 @@ +! { dg-do compile } +! Verify that initialization of c_ptr components works. +module fgsl + use, intrinsic :: iso_c_binding + implicit none + type, public :: fgsl_matrix + private + type(c_ptr) :: gsl_matrix = c_null_ptr + end type fgsl_matrix + type, public :: fgsl_multifit_fdfsolver + private + type(c_ptr) :: gsl_multifit_fdfsolver = c_null_ptr + end type fgsl_multifit_fdfsolver +interface + function gsl_multifit_fdfsolver_jac(s) bind(c) + import :: c_ptr + type(c_ptr), value :: s + type(c_ptr) :: gsl_multifit_fdfsolver_jac + end function gsl_multifit_fdfsolver_jac +end interface +contains + function fgsl_multifit_fdfsolver_jac(s) + type(fgsl_multifit_fdfsolver), intent(in) :: s + type(fgsl_matrix) :: fgsl_multifit_fdfsolver_jac + fgsl_multifit_fdfsolver_jac%gsl_matrix = & + gsl_multifit_fdfsolver_jac(s%gsl_multifit_fdfsolver) + end function fgsl_multifit_fdfsolver_jac +end module fgsl + +module m + use, intrinsic :: iso_c_binding, only: c_ptr, c_null_ptr + implicit none + type t + type(c_ptr) :: matrix = c_null_ptr + end type t +contains + subroutine func(a) + type(t), intent(out) :: a + end subroutine func +end module m +! { dg-final { cleanup-modules "fgsl m" } } +