re PR fortran/32797 ([ISO C Binding] Internal Error: gfc_basic_typename(): Undefined type)
2007-07-23 Christopher D. Rickett <crickett@lanl.gov> PR fortran/32797 PR fortran/32800 * decl.c (verify_bind_c_sym): Use the result symbol for functions with a result clause. Warn if implicitly typed. Verify the type and rank of the SHAPE argument, if given. * resolve.c (gfc_iso_c_sub_interface): Use gfc_procedure_use to check the actual args against the formal, sorting them if necessary. * symbol.c (gen_shape_param): Initialize type of SHAPE param to BT_VOID. 2007-07-23 Christopher D. Rickett <crickett@lanl.gov> PR fortran/32797 PR fortran/32800 * gfortran.dg/bind_c_usage_8.f03: New test case. * gfortran.dg/c_f_pointer_tests_2.f03: Ditto. * gfortran.dg/c_ptr_tests_5.f03: Updated expected error message. From-SVN: r126856
This commit is contained in:
parent
f4e00f444b
commit
d8fa96e089
|
@ -1,3 +1,16 @@
|
|||
2007-07-23 Christopher D. Rickett <crickett@lanl.gov>
|
||||
|
||||
PR fortran/32797
|
||||
PR fortran/32800
|
||||
* decl.c (verify_bind_c_sym): Use the result symbol for functions
|
||||
with a result clause. Warn if implicitly typed. Verify the type
|
||||
and rank of the SHAPE argument, if given.
|
||||
* resolve.c (gfc_iso_c_sub_interface): Use gfc_procedure_use to
|
||||
check the actual args against the formal, sorting them if
|
||||
necessary.
|
||||
* symbol.c (gen_shape_param): Initialize type of SHAPE param to
|
||||
BT_VOID.
|
||||
|
||||
2007-07-23 Christopher D. Rickett <crickett@lanl.gov>
|
||||
|
||||
PR fortran/32732
|
||||
|
|
|
@ -2927,6 +2927,22 @@ verify_bind_c_sym (gfc_symbol *tmp_sym, gfc_typespec *ts,
|
|||
int is_in_common, gfc_common_head *com_block)
|
||||
{
|
||||
try retval = SUCCESS;
|
||||
|
||||
if (tmp_sym->attr.function && tmp_sym->result != NULL)
|
||||
{
|
||||
tmp_sym = tmp_sym->result;
|
||||
/* Make sure it wasn't an implicitly typed result. */
|
||||
if (tmp_sym->attr.implicit_type)
|
||||
{
|
||||
gfc_warning ("Implicitly declared BIND(C) function '%s' at "
|
||||
"%L may not be C interoperable", tmp_sym->name,
|
||||
&tmp_sym->declared_at);
|
||||
tmp_sym->ts.f90_type = tmp_sym->ts.type;
|
||||
/* Mark it as C interoperable to prevent duplicate warnings. */
|
||||
tmp_sym->ts.is_c_interop = 1;
|
||||
tmp_sym->attr.is_c_interop = 1;
|
||||
}
|
||||
}
|
||||
|
||||
/* Here, we know we have the bind(c) attribute, so if we have
|
||||
enough type info, then verify that it's a C interop kind.
|
||||
|
|
|
@ -2323,7 +2323,15 @@ gfc_iso_c_sub_interface (gfc_code *c, gfc_symbol *sym)
|
|||
char binding_label[GFC_MAX_BINDING_LABEL_LEN + 1];
|
||||
/* default to success; will override if find error */
|
||||
match m = MATCH_YES;
|
||||
gfc_symbol *tmp_sym;
|
||||
|
||||
/* Make sure the actual arguments are in the necessary order (based on the
|
||||
formal args) before resolving. */
|
||||
gfc_procedure_use (sym, &c->ext.actual, &(c->loc));
|
||||
|
||||
/* Give the optional SHAPE formal arg a type now that we've done our
|
||||
initial checking against the actual. */
|
||||
if (sym->intmod_sym_id == ISOCBINDING_F_POINTER)
|
||||
sym->formal->next->next->sym->ts.type = BT_INTEGER;
|
||||
|
||||
if ((sym->intmod_sym_id == ISOCBINDING_F_POINTER) ||
|
||||
(sym->intmod_sym_id == ISOCBINDING_F_PROCPOINTER))
|
||||
|
@ -2334,25 +2342,29 @@ gfc_iso_c_sub_interface (gfc_code *c, gfc_symbol *sym)
|
|||
{
|
||||
if (c->ext.actual != NULL && c->ext.actual->next != NULL)
|
||||
{
|
||||
/* Make sure we got a third arg. The type/rank of it will
|
||||
be checked later if it's there (gfc_procedure_use()). */
|
||||
if (c->ext.actual->next->expr->rank != 0 &&
|
||||
c->ext.actual->next->next == NULL)
|
||||
/* Make sure we got a third arg if the second arg has non-zero
|
||||
rank. We must also check that the type and rank are
|
||||
correct since we short-circuit this check in
|
||||
gfc_procedure_use() (called above to sort actual args). */
|
||||
if (c->ext.actual->next->expr->rank != 0)
|
||||
{
|
||||
m = MATCH_ERROR;
|
||||
gfc_error ("Missing SHAPE parameter for call to %s "
|
||||
"at %L", sym->name, &(c->loc));
|
||||
if(c->ext.actual->next->next == NULL
|
||||
|| c->ext.actual->next->next->expr == NULL)
|
||||
{
|
||||
m = MATCH_ERROR;
|
||||
gfc_error ("Missing SHAPE parameter for call to %s "
|
||||
"at %L", sym->name, &(c->loc));
|
||||
}
|
||||
else if (c->ext.actual->next->next->expr->ts.type
|
||||
!= BT_INTEGER
|
||||
|| c->ext.actual->next->next->expr->rank != 1)
|
||||
{
|
||||
m = MATCH_ERROR;
|
||||
gfc_error ("SHAPE parameter for call to %s at %L must "
|
||||
"be a rank 1 INTEGER array", sym->name,
|
||||
&(c->loc));
|
||||
}
|
||||
}
|
||||
/* Make sure the param is a POINTER. No need to make sure
|
||||
it does not have INTENT(IN) since it is a POINTER. */
|
||||
tmp_sym = c->ext.actual->next->expr->symtree->n.sym;
|
||||
if (tmp_sym != NULL && tmp_sym->attr.pointer != 1)
|
||||
{
|
||||
gfc_error ("Argument '%s' to '%s' at %L "
|
||||
"must have the POINTER attribute",
|
||||
tmp_sym->name, sym->name, &(c->loc));
|
||||
m = MATCH_ERROR;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
@ -2405,10 +2417,7 @@ gfc_iso_c_sub_interface (gfc_code *c, gfc_symbol *sym)
|
|||
|
||||
/* set the resolved symbol */
|
||||
if (m != MATCH_ERROR)
|
||||
{
|
||||
gfc_procedure_use (new_sym, &c->ext.actual, &c->loc);
|
||||
c->resolved_sym = new_sym;
|
||||
}
|
||||
c->resolved_sym = new_sym;
|
||||
else
|
||||
c->resolved_sym = sym;
|
||||
|
||||
|
|
|
@ -3419,8 +3419,12 @@ gen_shape_param (gfc_formal_arglist **head,
|
|||
param_sym->attr.dummy = 1;
|
||||
param_sym->attr.use_assoc = 1;
|
||||
|
||||
/* Integer array, rank 1, describing the shape of the object. */
|
||||
param_sym->ts.type = BT_INTEGER;
|
||||
/* Integer array, rank 1, describing the shape of the object. Make it's
|
||||
type BT_VOID initially so we can accept any type/kind combination of
|
||||
integer. During gfc_iso_c_sub_interface (resolve.c), we'll make it
|
||||
of BT_INTEGER type. */
|
||||
param_sym->ts.type = BT_VOID;
|
||||
|
||||
/* Initialize the kind to default integer. However, it will be overriden
|
||||
during resolution to match the kind of the SHAPE parameter given as
|
||||
the actual argument (to allow for any valid integer kind). */
|
||||
|
|
|
@ -1,3 +1,11 @@
|
|||
2007-07-23 Christopher D. Rickett <crickett@lanl.gov>
|
||||
|
||||
PR fortran/32797
|
||||
PR fortran/32800
|
||||
* gfortran.dg/bind_c_usage_8.f03: New test case.
|
||||
* gfortran.dg/c_f_pointer_tests_2.f03: Ditto.
|
||||
* gfortran.dg/c_ptr_tests_5.f03: Updated expected error message.
|
||||
|
||||
2007-07-23 Richard Sandiford <richard@codesourcery.com>
|
||||
|
||||
* gcc.target/mips/branch-cost-1.c: New test.
|
||||
|
|
|
@ -0,0 +1,25 @@
|
|||
! { dg-do compile }
|
||||
! This should compile, though there is a warning about the type of len
|
||||
! (return variable of strlen()) for being implicit.
|
||||
! PR fortran/32797
|
||||
!
|
||||
MODULE ISO_C_UTILITIES
|
||||
USE ISO_C_BINDING
|
||||
implicit none
|
||||
CHARACTER(C_CHAR), DIMENSION(1), SAVE, TARGET, PRIVATE :: dummy_string="?"
|
||||
CONTAINS
|
||||
FUNCTION C_F_STRING(CPTR) RESULT(FPTR)
|
||||
use, intrinsic :: iso_c_binding
|
||||
TYPE(C_PTR), INTENT(IN) :: CPTR ! The C address
|
||||
CHARACTER(KIND=C_CHAR), DIMENSION(:), POINTER :: FPTR
|
||||
INTERFACE
|
||||
FUNCTION strlen(string) RESULT(len) BIND(C,NAME="strlen") ! { dg-warning "Implicitly declared" }
|
||||
USE ISO_C_BINDING
|
||||
TYPE(C_PTR), VALUE :: string ! A C pointer
|
||||
END FUNCTION
|
||||
END INTERFACE
|
||||
CALL C_F_POINTER(FPTR=FPTR, CPTR=CPTR, SHAPE=[strlen(CPTR)])
|
||||
END FUNCTION
|
||||
END MODULE ISO_C_UTILITIES
|
||||
! { dg-final { cleanup-modules "iso_c_utilities" } }
|
||||
|
|
@ -0,0 +1,20 @@
|
|||
! { dg-do compile }
|
||||
! This should compile. There was a bug in resolving c_f_pointer that was
|
||||
! caused by not sorting the actual args to match the order of the formal args.
|
||||
! PR fortran/32800
|
||||
!
|
||||
FUNCTION C_F_STRING(CPTR) RESULT(FPTR)
|
||||
USE ISO_C_BINDING
|
||||
implicit none
|
||||
TYPE(C_PTR), INTENT(IN) :: CPTR ! The C address
|
||||
CHARACTER(KIND=C_CHAR), DIMENSION(:), POINTER :: FPTR
|
||||
INTERFACE
|
||||
FUNCTION strlen(string) RESULT(len) BIND(C,NAME="strlen")
|
||||
import
|
||||
TYPE(C_PTR), VALUE :: string ! A C pointer
|
||||
integer(c_int) :: len
|
||||
END FUNCTION strlen
|
||||
END INTERFACE
|
||||
CALL C_F_POINTER(FPTR=FPTR, CPTR=CPTR,SHAPE=[strlen(cptr)])
|
||||
END FUNCTION C_F_STRING
|
||||
|
|
@ -11,6 +11,6 @@ contains
|
|||
type(c_ptr), value :: c_struct
|
||||
type(my_f90_type) :: f90_type
|
||||
|
||||
call c_f_pointer(c_struct, f90_type) ! { dg-error "must have the POINTER" }
|
||||
call c_f_pointer(c_struct, f90_type) ! { dg-error "must be a pointer" }
|
||||
end subroutine sub0
|
||||
end module c_ptr_tests_5
|
||||
|
|
Loading…
Reference in New Issue