re PR fortran/33040 ([ISO_C_BINDING] ICE in gfc_trans_structure_assign)

2007-09-11  Christopher D. Rickett  <crickett@lanl.gov>

	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  <crickett@lanl.gov>

	PR fortran/33040
	* gfortran.dg/c_ptr_tests_11.f03: New test case.

From-SVN: r128385
This commit is contained in:
Christopher D. Rickett 2007-09-11 17:53:22 +02:00 committed by Tobias Burnus
parent fa6763a6fc
commit 9dc3595654
5 changed files with 95 additions and 6 deletions

View file

@ -1,3 +1,12 @@
2007-09-11 Christopher D. Rickett <crickett@lanl.gov>
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 <jh@suse.cz>
* f95-lang.c (gfc_expand_function): Kill.

View file

@ -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);

View file

@ -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;
}
}
}

View file

@ -1,3 +1,8 @@
2007-09-11 Christopher D. Rickett <crickett@lanl.gov>
PR fortran/33040
* gfortran.dg/c_ptr_tests_11.f03: New test case.
2007-09-11 Jakub Jelinek <jakub@redhat.com>
* gcc.dg/va-arg-pack-len-1.c: New test.
@ -25,15 +30,15 @@
2007-09-10 Harsha Jagasia <harsha.jagasia@amd.com>
* 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 <richard@codesourcery.com>
@ -345,7 +350,7 @@
2007-09-05 Sandra Loosemore <sandra@codesourcery.com>
David Ung <davidu@mips.com>
Nigel Stephens <nigel@mips.com>
Nigel Stephens <nigel@mips.com>
* 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 <sandra@codesourcery.com>
David Ung <davidu@mips.com>
Nigel Stephens <nigel@mips.com>
Nigel Stephens <nigel@mips.com>
* gcc.target/mips/mips16-attributes.c: New.

View file

@ -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" } }