diff options
author | Christopher D. Rickett <crickett@lanl.gov> | 2007-07-12 19:52:03 +0000 |
---|---|---|
committer | Tobias Burnus <burnus@gcc.gnu.org> | 2007-07-12 21:52:03 +0200 |
commit | aa5e22f00044aff47df0997d9f5d794e91cba2dd (patch) | |
tree | ad18ce5b4ba81913b817ca8211398ca81949308b /gcc/fortran | |
parent | 26a9718401a4987165af4451cfda69be08613640 (diff) | |
download | gcc-aa5e22f00044aff47df0997d9f5d794e91cba2dd.zip gcc-aa5e22f00044aff47df0997d9f5d794e91cba2dd.tar.gz gcc-aa5e22f00044aff47df0997d9f5d794e91cba2dd.tar.bz2 |
re PR fortran/32599 ([ISO C Binding] Accepts character with len /= 1)
2007-07-12 Christopher D. Rickett <crickett@lanl.gov>
PR fortran/32599
* decl.c (verify_c_interop_param): Require character string dummy
args to BIND(C) procedures to have length 1.
* resolve.c (resolve_fl_procedure): Modify parameter checking for
BIND(C) procedures.
PR fortran/32601
* resolve.c (gfc_iso_c_func_interface): Verify that a valid
expression is given as an argument to C_LOC and C_ASSOCIATED.
* trans-io.c (transfer_expr): Add argument for code block. Add
standards check to determine if an error message should be
reported for printing C_PTR or C_FUNPTR.
(transfer_array_component): Update arguments to transfer_expr.
(gfc_trans_transfer): Ditto.
* symbol.c (gen_cptr_param): Fix whitespace.
2007-07-12 Christopher D. Rickett <crickett@lanl.gov>
PR fortran/32599
* gfortran.dg/32599.f03: New test case.
PR fortran/32601
* gfortran.dg/32601.f03: New test case.
* gfortran.dg/32601_1.f03: Ditto.
* gfortran.dg/c_ptr_tests_9.f03: Updated dg-options.
* gfortran.dg/c_ptr_tests_10.f03: Ditto.
From-SVN: r126598
Diffstat (limited to 'gcc/fortran')
-rw-r--r-- | gcc/fortran/ChangeLog | 19 | ||||
-rw-r--r-- | gcc/fortran/decl.c | 19 | ||||
-rw-r--r-- | gcc/fortran/resolve.c | 37 | ||||
-rw-r--r-- | gcc/fortran/symbol.c | 5 | ||||
-rw-r--r-- | gcc/fortran/trans-io.c | 30 |
5 files changed, 88 insertions, 22 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index ef75186..151b7d9 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,22 @@ +2007-07-12 Christopher D. Rickett <crickett@lanl.gov> + + PR fortran/32599 + * decl.c (verify_c_interop_param): Require character string dummy + args to BIND(C) procedures to have length 1. + * resolve.c (resolve_fl_procedure): Modify parameter checking for + BIND(C) procedures. + + PR fortran/32601 + * resolve.c (gfc_iso_c_func_interface): Verify that a valid + expression is given as an argument to C_LOC and C_ASSOCIATED. + * trans-io.c (transfer_expr): Add argument for code block. Add + standards check to determine if an error message should be + reported for printing C_PTR or C_FUNPTR. + (transfer_array_component): Update arguments to transfer_expr. + (gfc_trans_transfer): Ditto. + + * symbol.c (gen_cptr_param): Fix whitespace. + 2007-07-12 Jakub Jelinek <jakub@redhat.com> PR fortran/32550 diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 67e8ef7..00241b8 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -838,7 +838,24 @@ verify_c_interop_param (gfc_symbol *sym) sym->name, &(sym->declared_at), sym->ns->proc_name->name); } - + + /* Character strings are only C interoperable if they have a + length of 1. */ + if (sym->ts.type == BT_CHARACTER) + { + gfc_charlen *cl = sym->ts.cl; + if (!cl || !cl->length || cl->length->expr_type != EXPR_CONSTANT + || mpz_cmp_si (cl->length->value.integer, 1) != 0) + { + gfc_error ("Character argument '%s' at %L " + "must be length 1 because " + "procedure '%s' is BIND(C)", + sym->name, &sym->declared_at, + sym->ns->proc_name->name); + retval = FAILURE; + } + } + /* We have to make sure that any param to a bind(c) routine does not have the allocatable, pointer, or optional attributes, according to J3/04-007, section 5.1. */ diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 911d5ec..f12cbd4 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -1717,6 +1717,15 @@ gfc_iso_c_func_interface (gfc_symbol *sym, gfc_actual_arglist *args, try retval = SUCCESS; gfc_symbol *args_sym; + if (args->expr->expr_type == EXPR_CONSTANT + || args->expr->expr_type == EXPR_OP + || args->expr->expr_type == EXPR_NULL) + { + gfc_error ("Argument to '%s' at %L is not a variable", + sym->name, &(args->expr->where)); + return FAILURE; + } + args_sym = args->expr->symtree->n.sym; if (sym->intmod_sym_id == ISOCBINDING_ASSOCIATED) @@ -6798,6 +6807,7 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag) if (sym->attr.is_bind_c && sym->attr.is_c_interop != 1) { gfc_formal_arglist *curr_arg; + int has_non_interop_arg = 0; if (verify_bind_c_sym (sym, &(sym->ts), sym->attr.in_common, sym->common_block) == FAILURE) @@ -6819,18 +6829,25 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag) while (curr_arg != NULL) { /* Skip implicitly typed dummy args here. */ - if (curr_arg->sym->attr.implicit_type == 0 - && verify_c_interop_param (curr_arg->sym) == FAILURE) - { - /* If something is found to fail, mark the symbol for the - procedure as not being BIND(C) to try and prevent multiple - errors being reported. */ - sym->attr.is_c_interop = 0; - sym->ts.is_c_interop = 0; - sym->attr.is_bind_c = 0; - } + if (curr_arg->sym->attr.implicit_type == 0) + if (verify_c_interop_param (curr_arg->sym) == FAILURE) + /* If something is found to fail, record the fact so we + can mark the symbol for the procedure as not being + BIND(C) to try and prevent multiple errors being + reported. */ + has_non_interop_arg = 1; + curr_arg = curr_arg->next; } + + /* See if any of the arguments were not interoperable and if so, clear + the procedure symbol to prevent duplicate error messages. */ + if (has_non_interop_arg != 0) + { + sym->attr.is_c_interop = 0; + sym->ts.is_c_interop = 0; + sym->attr.is_bind_c = 0; + } } return SUCCESS; diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index 5e76fe2..e83c190 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -3290,7 +3290,6 @@ gen_cptr_param (gfc_formal_arglist **head, if (iso_c_sym_id == ISOCBINDING_F_PROCPOINTER) c_ptr_type = "_gfortran_iso_c_binding_c_funptr"; - else c_ptr_type = "_gfortran_iso_c_binding_c_ptr"; @@ -3321,7 +3320,7 @@ gen_cptr_param (gfc_formal_arglist **head, if (iso_c_sym_id == ISOCBINDING_F_PROCPOINTER) c_ptr_sym = get_iso_c_binding_dt (ISOCBINDING_FUNPTR); else - c_ptr_sym = get_iso_c_binding_dt (ISOCBINDING_PTR); + c_ptr_sym = get_iso_c_binding_dt (ISOCBINDING_PTR); if (c_ptr_sym == NULL) { /* This can happen if the user did not define c_ptr but they are @@ -3330,7 +3329,7 @@ gen_cptr_param (gfc_formal_arglist **head, generate_isocbinding_symbol (module_name, ISOCBINDING_FUNPTR, (char *)c_ptr_type); else - generate_isocbinding_symbol (module_name, ISOCBINDING_PTR, + generate_isocbinding_symbol (module_name, ISOCBINDING_PTR, (char *)c_ptr_type); gfc_get_ha_symbol (c_ptr_type, &(c_ptr_sym)); diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c index 4d7695e..4b70871 100644 --- a/gcc/fortran/trans-io.c +++ b/gcc/fortran/trans-io.c @@ -1712,7 +1712,7 @@ gfc_trans_dt_end (gfc_code * code) } static void -transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr); +transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr, gfc_code * code); /* Given an array field in a derived type variable, generate the code for the loop that iterates over array elements, and the code that @@ -1780,7 +1780,7 @@ transfer_array_component (tree expr, gfc_component * cm) /* Now se.expr contains an element of the array. Take the address and pass it to the IO routines. */ tmp = build_fold_addr_expr (se.expr); - transfer_expr (&se, &cm->ts, tmp); + transfer_expr (&se, &cm->ts, tmp, NULL); /* We are done now with the loop body. Wrap up the scalarizer and return. */ @@ -1805,7 +1805,7 @@ transfer_array_component (tree expr, gfc_component * cm) /* Generate the call for a scalar transfer node. */ static void -transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr) +transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr, gfc_code * code) { tree tmp, function, arg2, field, expr; gfc_component *c; @@ -1814,9 +1814,23 @@ transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr) /* It is possible to get a C_NULL_PTR or C_NULL_FUNPTR expression here if the user says something like: print *, 'c_null_ptr: ', c_null_ptr We need to translate the expression to a constant if it's either - C_NULL_PTR or C_NULL_FUNPTR. */ - if (ts->type == BT_DERIVED && ts->is_iso_c == 1 && ts->derived != NULL) + C_NULL_PTR or C_NULL_FUNPTR. We could also get a user variable of + type C_PTR or C_FUNPTR, in which case the ts->type may no longer be + BT_DERIVED (could have been changed by gfc_conv_expr). */ + if ((ts->type == BT_DERIVED && ts->is_iso_c == 1 && ts->derived != NULL) + || (ts->derived != NULL && ts->derived->ts.is_iso_c == 1)) { + /* C_PTR and C_FUNPTR have private components which means they can not + be printed. However, if -std=gnu and not -pedantic, allow + the component to be printed to help debugging. */ + if (gfc_notification_std (GFC_STD_GNU) != SILENT) + { + gfc_error_now ("Derived type '%s' at %L has PRIVATE components", + ts->derived->name, code != NULL ? &(code->loc) : + &gfc_current_locus); + return; + } + ts->type = ts->derived->ts.type; ts->kind = ts->derived->ts.kind; ts->f90_type = ts->derived->ts.f90_type; @@ -1883,7 +1897,7 @@ transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr) { if (!c->pointer) tmp = build_fold_addr_expr (tmp); - transfer_expr (se, &c->ts, tmp); + transfer_expr (se, &c->ts, tmp, code); } } return; @@ -1949,7 +1963,7 @@ gfc_trans_transfer (gfc_code * code) { /* Transfer a scalar value. */ gfc_conv_expr_reference (&se, expr); - transfer_expr (&se, &expr->ts, se.expr); + transfer_expr (&se, &expr->ts, se.expr, code); } else { @@ -1988,7 +2002,7 @@ gfc_trans_transfer (gfc_code * code) se.ss = ss; gfc_conv_expr_reference (&se, expr); - transfer_expr (&se, &expr->ts, se.expr); + transfer_expr (&se, &expr->ts, se.expr, code); } finish_block_label: |