diff options
| author | Janus Weil <janus@gcc.gnu.org> | 2010-07-14 10:09:05 +0200 |
|---|---|---|
| committer | Janus Weil <janus@gcc.gnu.org> | 2010-07-14 10:09:05 +0200 |
| commit | f6199e635e7a3286d5580d17903e881e2701d1a8 (patch) | |
| tree | 54a2c46fe1716df95f4f8171b512adec531cd9f1 /gcc/fortran/resolve.c | |
| parent | fa86d337f691f622a4ff946b8b8e87deffb72f7f (diff) | |
| download | gcc-f6199e635e7a3286d5580d17903e881e2701d1a8.zip gcc-f6199e635e7a3286d5580d17903e881e2701d1a8.tar.gz gcc-f6199e635e7a3286d5580d17903e881e2701d1a8.tar.bz2 | |
re PR fortran/44925 ([OOP] C_LOC with CLASS pointer)
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 Janus Weil <janus@gcc.gnu.org>
PR fortran/44925
* gfortran.dg/c_loc_tests_15.f90: New.
From-SVN: r162169
Diffstat (limited to 'gcc/fortran/resolve.c')
| -rw-r--r-- | gcc/fortran/resolve.c | 17 |
1 files changed, 12 insertions, 5 deletions
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 640a4d8..15b67d4 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) |