From 8a9adf2c8fde74d9789b01f5c35c0e652dd69a8a Mon Sep 17 00:00:00 2001 From: Thomas Koenig Date: Sat, 22 Jan 2011 17:30:22 +0000 Subject: re PR fortran/38536 (ICE with C_LOC in resolve.c due to not properly going through expr->ref) 2011-01-22 Thomas Koenig PR fortran/38536 * resolve.c (gfc_iso_c_func_interface): For C_LOC, check for array sections followed by component references which are illegal. Also check for coindexed arguments. 2011-01-22 Thomas Koenig PR fortran/38536 * gfortran.dg/c_loc_tests_16.f90: New test. From-SVN: r169130 --- gcc/fortran/ChangeLog | 7 +++++ gcc/fortran/resolve.c | 42 ++++++++++++++++++++++++++++ gcc/testsuite/ChangeLog | 7 ++++- gcc/testsuite/gfortran.dg/c_loc_tests_16.f90 | 25 +++++++++++++++++ 4 files changed, 80 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/gfortran.dg/c_loc_tests_16.f90 (limited to 'gcc') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index f0562ac..e918ef5 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2011-01-22 Thomas Koenig + + PR fortran/38536 + * resolve.c (gfc_iso_c_func_interface): For C_LOC, + check for array sections followed by component references + which are illegal. Also check for coindexed arguments. + 2011-01-22 Tobias Burnus PR fortran/47399 diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index f2e7223..9f0d675 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -2699,6 +2699,9 @@ gfc_iso_c_func_interface (gfc_symbol *sym, gfc_actual_arglist *args, } else if (sym->intmod_sym_id == ISOCBINDING_LOC) { + gfc_ref *ref; + bool seen_section; + /* Make sure we have either the target or pointer attribute. */ if (!arg_attr.target && !arg_attr.pointer) { @@ -2709,6 +2712,45 @@ gfc_iso_c_func_interface (gfc_symbol *sym, gfc_actual_arglist *args, retval = FAILURE; } + if (gfc_is_coindexed (args->expr)) + { + gfc_error_now ("Coindexed argument not permitted" + " in '%s' call at %L", name, + &(args->expr->where)); + retval = FAILURE; + } + + /* Follow references to make sure there are no array + sections. */ + seen_section = false; + + for (ref=args->expr->ref; ref; ref = ref->next) + { + if (ref->type == REF_ARRAY) + { + if (ref->u.ar.type == AR_SECTION) + seen_section = true; + + if (ref->u.ar.type != AR_ELEMENT) + { + gfc_ref *r; + for (r = ref->next; r; r=r->next) + if (r->type == REF_COMPONENT) + { + gfc_error_now ("Array section not permitted" + " in '%s' call at %L", name, + &(args->expr->where)); + retval = FAILURE; + break; + } + } + } + } + + if (seen_section && retval == SUCCESS) + gfc_warning ("Array section in '%s' call at %L", name, + &(args->expr->where)); + /* See if we have interoperable type and type param. */ if (verify_c_interop (arg_ts) == SUCCESS || gfc_check_any_c_kind (arg_ts) == SUCCESS) diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index d0a8f40..ce423e1 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2011-01-22 Thomas Koenig + + PR fortran/38536 + * gfortran.dg/c_loc_tests_16.f90: New test. + 2011-01-22 Tobias Burnus PR fortran/47399 @@ -7,7 +12,7 @@ PR tree-optimization/47053 * g++.dg/pr47053.C: New test. - + 2011-01-21 Jason Merrill PR c++/47041 diff --git a/gcc/testsuite/gfortran.dg/c_loc_tests_16.f90 b/gcc/testsuite/gfortran.dg/c_loc_tests_16.f90 new file mode 100644 index 0000000..1c86a1f9 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/c_loc_tests_16.f90 @@ -0,0 +1,25 @@ +! { dg-do compile } +! { dg-options "-fcoarray=single" } +! PR 38536 - array sections as arguments to c_loc are illegal. + use iso_c_binding + type, bind(c) :: t1 + integer(c_int) :: i(5) + end type t1 + type, bind(c):: t2 + type(t1) :: t(5) + end type t2 + type, bind(c) :: t3 + type(t1) :: t(5,5) + end type t3 + + type(t2), target :: tt + type(t3), target :: ttt + integer(c_int), target :: n(3) + integer(c_int), target :: x[*] + type(C_PTR) :: p + + p = c_loc(tt%t%i(1)) ! { dg-error "Array section not permitted" } + p = c_loc(n(1:2)) ! { dg-warning "Array section" } + p = c_loc(ttt%t(5,1:2)%i(1)) ! { dg-error "Array section not permitted" } + p = c_loc(x[1]) ! { dg-error "Coindexed argument not permitted" } + end -- cgit v1.1