diff options
| -rw-r--r-- | gcc/fortran/ChangeLog | 9 | ||||
| -rw-r--r-- | gcc/fortran/dependency.c | 2 | ||||
| -rw-r--r-- | gcc/fortran/gfortran.h | 1 | ||||
| -rw-r--r-- | gcc/fortran/intrinsic.texi | 6 | ||||
| -rw-r--r-- | gcc/fortran/resolve.c | 17 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/c_loc_tests_15.f90 | 16 |
7 files changed, 46 insertions, 10 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index e8eeffc6760..2f028b1299c 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,12 @@ +2010-07-14 Janus Weil <janus@gcc.gnu.org> + + PR fortran/44925 + * gfortran.h (gfc_is_data_pointer): Remove prototype. + * dependency.c (gfc_is_data_pointer): Make it static. + * intrinsic.texi: Update documentation on C_LOC. + * resolve.c (gfc_iso_c_func_interface): Fix pointer and target checks + and add a check for polymorphic variables. + 2010-07-14 Jakub Jelinek <jakub@redhat.com> * trans-expr.c (string_to_single_character): Also optimize diff --git a/gcc/fortran/dependency.c b/gcc/fortran/dependency.c index fcf5b25d350..083058dab8b 100644 --- a/gcc/fortran/dependency.c +++ b/gcc/fortran/dependency.c @@ -424,7 +424,7 @@ gfc_ref_needs_temporary_p (gfc_ref *ref) } -int +static int gfc_is_data_pointer (gfc_expr *e) { gfc_ref *ref; diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index cf14bb46af2..11ff594f59b 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -2810,7 +2810,6 @@ void gfc_global_used (gfc_gsymbol *, locus *); /* dependency.c */ int gfc_dep_compare_expr (gfc_expr *, gfc_expr *); -int gfc_is_data_pointer (gfc_expr *); /* check.c */ gfc_try gfc_check_same_strlen (const gfc_expr*, const gfc_expr*, const char*); diff --git a/gcc/fortran/intrinsic.texi b/gcc/fortran/intrinsic.texi index af2f3b2816a..2e91a3eb37a 100644 --- a/gcc/fortran/intrinsic.texi +++ b/gcc/fortran/intrinsic.texi @@ -2142,9 +2142,9 @@ Inquiry function @code{RESULT = C_LOC(X)} @item @emph{Arguments}: -@multitable @columnfractions .15 .70 -@item @var{X} @tab Associated scalar pointer or interoperable scalar -or allocated allocatable variable with @code{TARGET} attribute. +@multitable @columnfractions .10 .75 +@item @var{X} @tab Shall have either the POINTER or TARGET attribute. It shall not be a coindexed object. It shall either be a variable with interoperable type and kind type parameters, or be a scalar, nonpolymorphic variable with no length type parameters. + @end multitable @item @emph{Return value}: diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 640a4d89fe1..15b67d46ca1 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -2440,10 +2440,11 @@ gfc_iso_c_func_interface (gfc_symbol *sym, gfc_actual_arglist *args, { char name[GFC_MAX_SYMBOL_LEN + 1]; char binding_label[GFC_MAX_BINDING_LABEL_LEN + 1]; - int optional_arg = 0, is_pointer = 0; + int optional_arg = 0; gfc_try retval = SUCCESS; gfc_symbol *args_sym; gfc_typespec *arg_ts; + symbol_attribute arg_attr; if (args->expr->expr_type == EXPR_CONSTANT || args->expr->expr_type == EXPR_OP @@ -2460,8 +2461,7 @@ gfc_iso_c_func_interface (gfc_symbol *sym, gfc_actual_arglist *args, and not necessarily that of the expr symbol (args_sym), because the actual expression could be a part-ref of the expr symbol. */ arg_ts = &(args->expr->ts); - - is_pointer = gfc_is_data_pointer (args->expr); + arg_attr = gfc_expr_attr (args->expr); if (sym->intmod_sym_id == ISOCBINDING_ASSOCIATED) { @@ -2504,7 +2504,7 @@ gfc_iso_c_func_interface (gfc_symbol *sym, gfc_actual_arglist *args, else if (sym->intmod_sym_id == ISOCBINDING_LOC) { /* Make sure we have either the target or pointer attribute. */ - if (!args_sym->attr.target && !is_pointer) + if (!arg_attr.target && !arg_attr.pointer) { gfc_error_now ("Parameter '%s' to '%s' at %L must be either " "a TARGET or an associated pointer", @@ -2587,7 +2587,7 @@ gfc_iso_c_func_interface (gfc_symbol *sym, gfc_actual_arglist *args, } } } - else if (is_pointer + else if (arg_attr.pointer && is_scalar_expr_ptr (args->expr) != SUCCESS) { /* Case 1c, section 15.1.2.5, J3/04-007: an associated @@ -2622,6 +2622,13 @@ gfc_iso_c_func_interface (gfc_symbol *sym, gfc_actual_arglist *args, &(args->expr->where)); retval = FAILURE; } + else if (arg_ts->type == BT_CLASS) + { + gfc_error_now ("Parameter '%s' to '%s' at %L must not be " + "polymorphic", args_sym->name, sym->name, + &(args->expr->where)); + retval = FAILURE; + } } } else if (sym->intmod_sym_id == ISOCBINDING_FUNLOC) diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index aa86ae395b9..44785593ce2 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2010-07-14 Janus Weil <janus@gcc.gnu.org> + + PR fortran/44925 + * gfortran.dg/c_loc_tests_15.f90: New. + 2010-07-13 Jason Merrill <jason@redhat.com> PR c++/44909 diff --git a/gcc/testsuite/gfortran.dg/c_loc_tests_15.f90 b/gcc/testsuite/gfortran.dg/c_loc_tests_15.f90 new file mode 100644 index 00000000000..63f8816379e --- /dev/null +++ b/gcc/testsuite/gfortran.dg/c_loc_tests_15.f90 @@ -0,0 +1,16 @@ +! { dg-do compile } +! +! PR 44925: [OOP] C_LOC with CLASS pointer +! +! Contributed by Barron Bichon <barron.bichon@swri.org> + + use iso_c_binding + + type :: t + end type t + + type(c_ptr) :: tt_cptr + class(t), pointer :: tt_fptr + if (associated(tt_fptr)) tt_cptr = c_loc(tt_fptr) ! { dg-error "must not be polymorphic" } + +end |