[PATCH,fortran]: fix for PRs 32797 and 32800
Christopher D. Rickett
crickett@lanl.gov
Wed Jul 18 18:09:00 GMT 2007
hi all,
the attached patch is for the PRs 32797 and 32800. the problem with 32797
was that the result was implicitly typed and the verify_bind_c_sym wasn't
catching it. for 32800, the arguments to c_f_pointer were not getting
sorted before being analyzed.
bootstrapped and regtested on x86 and x86_64 linux with no new failures.
Chris
:ADDPATCH fortran:
2007-07-18 Christopher D. Rickett <crickett@lanl.gov>
PR fortran/32797
PR fortran/32800
* gfortran.dg/pr32797.f03: New test case.
* gfortran.dg/pr32800.f03: Ditto.
* gfortran.dg/c_ptr_tests_5.f03: Updated expected error message.
2007-07-18 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.
-------------- next part --------------
Index: gcc/testsuite/gfortran.dg/c_ptr_tests_5.f03
===================================================================
--- gcc/testsuite/gfortran.dg/c_ptr_tests_5.f03 (revision 126704)
+++ gcc/testsuite/gfortran.dg/c_ptr_tests_5.f03 (working copy)
@@ -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
Index: gcc/testsuite/gfortran.dg/pr32797.f03
===================================================================
--- gcc/testsuite/gfortran.dg/pr32797.f03 (revision 0)
+++ gcc/testsuite/gfortran.dg/pr32797.f03 (revision 0)
@@ -0,0 +1,23 @@
+! { dg-do compile }
+! This should compile, though there is a warning about the type of len
+! (return variable of strlen()) for being implicit.
+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" } }
+
Index: gcc/testsuite/gfortran.dg/pr32800.f03
===================================================================
--- gcc/testsuite/gfortran.dg/pr32800.f03 (revision 0)
+++ gcc/testsuite/gfortran.dg/pr32800.f03 (revision 0)
@@ -0,0 +1,18 @@
+! { 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.
+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
+
Index: gcc/fortran/symbol.c
===================================================================
--- gcc/fortran/symbol.c (revision 126704)
+++ gcc/fortran/symbol.c (working copy)
@@ -3419,8 +3419,14 @@ gen_shape_param (gfc_formal_arglist **he
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 (to allow for any valid integer kind). */
param_sym->ts.kind = gfc_default_integer_kind;
param_sym->as = gfc_get_array_spec ();
Index: gcc/fortran/decl.c
===================================================================
--- gcc/fortran/decl.c (revision 126704)
+++ gcc/fortran/decl.c (working copy)
@@ -2927,6 +2927,22 @@ verify_bind_c_sym (gfc_symbol *tmp_sym,
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.
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c (revision 126704)
+++ gcc/fortran/resolve.c (working copy)
@@ -2284,7 +2289,15 @@ gfc_iso_c_sub_interface (gfc_code *c, gf
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))
@@ -2295,25 +2308,29 @@ gfc_iso_c_sub_interface (gfc_code *c, gf
{
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;
- }
}
}
@@ -2359,10 +2383,7 @@ gfc_iso_c_sub_interface (gfc_code *c, gf
/* 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;
More information about the Fortran
mailing list