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:
parent
fa6763a6fc
commit
9dc3595654
5 changed files with 95 additions and 6 deletions
|
@ -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.
|
||||
|
|
|
@ -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);
|
||||
|
|
|
@ -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;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
|
@ -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.
|
||||
|
||||
|
|
42
gcc/testsuite/gfortran.dg/c_ptr_tests_11.f03
Normal file
42
gcc/testsuite/gfortran.dg/c_ptr_tests_11.f03
Normal 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" } }
|
||||
|
Loading…
Add table
Reference in a new issue