OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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:
Christopher D. Rickett 2007-07-23 17:47:16 +00:00 committed by Tobias Burnus
parent f4e00f444b
commit d8fa96e089
8 changed files with 120 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
gcc/fortran/ChangeLog
View File

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

16
gcc/fortran/decl.c
View File

@ -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.

53
gcc/fortran/resolve.c
View File

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

8
gcc/fortran/symbol.c
View File

@ -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). */

8
gcc/testsuite/ChangeLog
View File

@ -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.

25
gcc/testsuite/gfortran.dg/bind_c_usage_8.f03 Normal file
View File

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

20
gcc/testsuite/gfortran.dg/c_f_pointer_tests_2.f03 Normal file
View File

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

2
gcc/testsuite/gfortran.dg/c_ptr_tests_5.f03
View File

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