It helps to attach the patch!
On Mon, 6 May 2019 at 19:57, Paul Richard Thomas <paul.richard.tho...@gmail.com> wrote: > > Unfortunately, this patch was still in the making at the release of > 9.1. It is more or less self explanatory with the ChangeLogs. > > It should be noted that gfc_conv_expr_present could not be used in the > fix for PR90093 because the passed descriptor is a CFI type. Instead, > the test is for a null pointer passed. > > The changes to trans-array.c(gfc_trans_create_temp_array) have an eye > on the future, as well as PR90355. I am progressing towards the point > where all descriptors have 'span' set correctly so that > trans.c(get_array_span) can be eliminated and much of the code in the > callers can be simplified. > > Bootstrapped and regtested on FC29/x86_64 - OK for trunk and 9-branch? > > Paul > > 2019-05-06 Paul Thomas <pa...@gcc.gnu.org> > > PR fortran/90093 > * trans-decl.c (convert_CFI_desc): Test that the dummy is > present before doing any of the conversions. > > PR fortran/90352 > * decl.c (gfc_verify_c_interop_param): Restore the error for > charlen > 1 actual arguments passed to bind(C) procs. > Clean up trailing white space. > > PR fortran/90355 > * trans-array.c (gfc_trans_create_temp_array): Set the 'span' > field to the element length for all types. > (gfc_conv_expr_descriptor): The force_no_tmp flag is used to > prevent temporary creation, especially for substrings. > * trans-decl.c (gfc_trans_deferred_vars): Rather than assert > that the backend decl for the string length is non-null, use it > as a condition before calling gfc_trans_vla_type_sizes. > * trans-expr.c (gfc_conv_gfc_desc_to_cfi_desc): 'force_no_tmp' > is set before calling gfc_conv_expr_descriptor. > * trans.c (get_array_span): Move the code for extracting 'span' > from gfc_build_array_ref to this function. This is specific to > descriptors that are component and indirect references. > * trans.h : Add the force_no_tmp flag bitfield to gfc_se. > > 2019-05-06 Paul Thomas <pa...@gcc.gnu.org> > > PR fortran/90093 > * gfortran.dg/ISO_Fortran_binding_12.f90: New test. > * gfortran.dg/ISO_Fortran_binding_12.c: Supplementary code. > > PR fortran/90352 > * gfortran.dg/iso_c_binding_char_1.f90: New test. > > PR fortran/90355 > * gfortran.dg/ISO_Fortran_binding_4.f90: Add 'substr' to test > the direct passing of substrings as descriptors to bind(C). > * gfortran.dg/assign_10.f90: Increase the tree_dump count of > 'atmp' to account for the setting of the 'span' field. > * gfortran.dg/transpose_optimization_2.f90: Ditto.
Index: gcc/fortran/decl.c =================================================================== *** gcc/fortran/decl.c (revision 270622) --- gcc/fortran/decl.c (working copy) *************** match_data_constant (gfc_expr **result) *** 406,412 **** contains the right constant expression. Check here. */ if ((*result)->symtree == NULL && (*result)->expr_type == EXPR_CONSTANT ! && ((*result)->ts.type == BT_INTEGER || (*result)->ts.type == BT_REAL)) return m; --- 406,412 ---- contains the right constant expression. Check here. */ if ((*result)->symtree == NULL && (*result)->expr_type == EXPR_CONSTANT ! && ((*result)->ts.type == BT_INTEGER || (*result)->ts.type == BT_REAL)) return m; *************** gfc_verify_c_interop_param (gfc_symbol * *** 1493,1511 **** /* Character strings are only C interoperable if they have a length of 1. */ ! if (sym->ts.type == BT_CHARACTER) { gfc_charlen *cl = sym->ts.u.cl; if (!cl || !cl->length || cl->length->expr_type != EXPR_CONSTANT || mpz_cmp_si (cl->length->value.integer, 1) != 0) { ! if (!gfc_notify_std (GFC_STD_F2018, ! "Character argument %qs at %L " ! "must be length 1 because " ! "procedure %qs is BIND(C)", ! sym->name, &sym->declared_at, ! sym->ns->proc_name->name)) ! retval = false; } } --- 1493,1510 ---- /* Character strings are only C interoperable if they have a length of 1. */ ! if (sym->ts.type == BT_CHARACTER && !sym->attr.dimension) { gfc_charlen *cl = sym->ts.u.cl; if (!cl || !cl->length || cl->length->expr_type != EXPR_CONSTANT || mpz_cmp_si (cl->length->value.integer, 1) != 0) { ! gfc_error ("Character argument %qs at %L " ! "must be length 1 because " ! "procedure %qs is BIND(C)", ! sym->name, &sym->declared_at, ! sym->ns->proc_name->name); ! retval = false; } } *************** static bool *** 6074,6080 **** in_module_or_interface(void) { if (gfc_current_state () == COMP_MODULE ! || gfc_current_state () == COMP_SUBMODULE || gfc_current_state () == COMP_INTERFACE) return true; --- 6073,6079 ---- in_module_or_interface(void) { if (gfc_current_state () == COMP_MODULE ! || gfc_current_state () == COMP_SUBMODULE || gfc_current_state () == COMP_INTERFACE) return true; *************** in_module_or_interface(void) *** 6085,6091 **** gfc_state_data *p; for (p = gfc_state_stack->previous; p ; p = p->previous) { ! if (p->state == COMP_MODULE || p->state == COMP_SUBMODULE || p->state == COMP_INTERFACE) return true; } --- 6084,6090 ---- gfc_state_data *p; for (p = gfc_state_stack->previous; p ; p = p->previous) { ! if (p->state == COMP_MODULE || p->state == COMP_SUBMODULE || p->state == COMP_INTERFACE) return true; } *************** gfc_match_formal_arglist (gfc_symbol *pr *** 6304,6310 **** } if (gfc_match_char (')') == MATCH_YES) ! { if (typeparam) { gfc_error_now ("A type parameter list is required at %C"); --- 6303,6309 ---- } if (gfc_match_char (')') == MATCH_YES) ! { if (typeparam) { gfc_error_now ("A type parameter list is required at %C"); *************** gfc_match_entry (void) *** 7489,7495 **** if (!gfc_add_is_bind_c (&(entry->attr), entry->name, &(entry->declared_at), 1)) return MATCH_ERROR; ! } if (!gfc_current_ns->parent --- 7488,7494 ---- if (!gfc_add_is_bind_c (&(entry->attr), entry->name, &(entry->declared_at), 1)) return MATCH_ERROR; ! } if (!gfc_current_ns->parent Index: gcc/fortran/trans-array.c =================================================================== *** gcc/fortran/trans-array.c (revision 270622) --- gcc/fortran/trans-array.c (working copy) *************** gfc_trans_create_temp_array (stmtblock_t *** 1239,1244 **** --- 1239,1245 ---- tree nelem; tree cond; tree or_expr; + tree elemsize; tree class_expr = NULL_TREE; int n, dim, tmp_dim; int total_dim = 0; *************** gfc_trans_create_temp_array (stmtblock_t *** 1333,1347 **** tmp = gfc_conv_descriptor_dtype (desc); gfc_add_modify (pre, tmp, gfc_get_dtype (TREE_TYPE (desc))); - /* Also set the span for derived types, since they can be used in - component references to arrays of this type. */ - if (TREE_CODE (eltype) == RECORD_TYPE) - { - tmp = TYPE_SIZE_UNIT (eltype); - tmp = fold_convert (gfc_array_index_type, tmp); - gfc_conv_descriptor_span_set (pre, desc, tmp); - } - /* Fill in the bounds and stride. This is a packed array, so: --- 1334,1339 ---- *************** gfc_trans_create_temp_array (stmtblock_t *** 1413,1434 **** } } /* Get the size of the array. */ if (size && !callee_alloc) { - tree elemsize; /* If or_expr is true, then the extent in at least one dimension is zero and the size is set to zero. */ size = fold_build3_loc (input_location, COND_EXPR, gfc_array_index_type, or_expr, gfc_index_zero_node, size); nelem = size; - if (class_expr == NULL_TREE) - elemsize = fold_convert (gfc_array_index_type, - TYPE_SIZE_UNIT (gfc_get_element_type (type))); - else - elemsize = gfc_class_vtab_size_get (class_expr); - size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type, size, elemsize); } --- 1405,1425 ---- } } + if (class_expr == NULL_TREE) + elemsize = fold_convert (gfc_array_index_type, + TYPE_SIZE_UNIT (gfc_get_element_type (type))); + else + elemsize = gfc_class_vtab_size_get (class_expr); + /* Get the size of the array. */ if (size && !callee_alloc) { /* If or_expr is true, then the extent in at least one dimension is zero and the size is set to zero. */ size = fold_build3_loc (input_location, COND_EXPR, gfc_array_index_type, or_expr, gfc_index_zero_node, size); nelem = size; size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type, size, elemsize); } *************** gfc_trans_create_temp_array (stmtblock_t *** 1438,1443 **** --- 1429,1438 ---- size = NULL_TREE; } + /* Set the span. */ + tmp = fold_convert (gfc_array_index_type, elemsize); + gfc_conv_descriptor_span_set (pre, desc, tmp); + gfc_trans_allocate_array_storage (pre, post, info, size, nelem, initial, dynamic, dealloc); *************** gfc_conv_expr_descriptor (gfc_se *se, gf *** 7248,7253 **** --- 7243,7250 ---- if (se->force_tmp) need_tmp = 1; + else if (se->force_no_tmp) + need_tmp = 0; if (need_tmp) full = 0; Index: gcc/fortran/trans-decl.c =================================================================== *** gcc/fortran/trans-decl.c (revision 270622) --- gcc/fortran/trans-decl.c (working copy) *************** convert_CFI_desc (gfc_wrapped_block * bl *** 4278,4285 **** --- 4278,4287 ---- tree CFI_desc_ptr; tree dummy_ptr; tree tmp; + tree present; tree incoming; tree outgoing; + stmtblock_t outer_block; stmtblock_t tmpblock; /* dummy_ptr will be the pointer to the passed array descriptor, *************** convert_CFI_desc (gfc_wrapped_block * bl *** 4303,4308 **** --- 4305,4316 ---- gfc_desc_ptr = gfc_create_var (tmp, "gfc_desc_ptr"); CFI_desc_ptr = gfc_create_var (pvoid_type_node, "CFI_desc_ptr"); + /* Fix the condition for the presence of the argument. */ + gfc_init_block (&outer_block); + present = fold_build2_loc (input_location, NE_EXPR, + logical_type_node, dummy_ptr, + build_int_cst (TREE_TYPE (dummy_ptr), 0)); + gfc_init_block (&tmpblock); /* Pointer to the gfc descriptor. */ gfc_add_modify (&tmpblock, gfc_desc_ptr, *************** convert_CFI_desc (gfc_wrapped_block * bl *** 4318,4333 **** /* Set the dummy pointer to point to the gfc_descriptor. */ gfc_add_modify (&tmpblock, dummy_ptr, fold_convert (TREE_TYPE (dummy_ptr), gfc_desc_ptr)); - incoming = gfc_finish_block (&tmpblock); ! gfc_init_block (&tmpblock); /* Convert the gfc descriptor back to the CFI type before going ! out of scope. */ tmp = gfc_build_addr_expr (ppvoid_type_node, CFI_desc_ptr); outgoing = build_call_expr_loc (input_location, gfor_fndecl_gfc_to_cfi, 2, tmp, gfc_desc_ptr); gfc_add_expr_to_block (&tmpblock, outgoing); ! outgoing = gfc_finish_block (&tmpblock); /* Add the lot to the procedure init and finally blocks. */ gfc_add_init_cleanup (block, incoming, outgoing); --- 4326,4368 ---- /* Set the dummy pointer to point to the gfc_descriptor. */ gfc_add_modify (&tmpblock, dummy_ptr, fold_convert (TREE_TYPE (dummy_ptr), gfc_desc_ptr)); ! /* The hidden string length is not passed to bind(C) procedures so set ! it from the descriptor element length. */ ! if (sym->ts.type == BT_CHARACTER ! && sym->ts.u.cl->backend_decl ! && VAR_P (sym->ts.u.cl->backend_decl)) ! { ! tmp = build_fold_indirect_ref_loc (input_location, dummy_ptr); ! tmp = gfc_conv_descriptor_elem_len (tmp); ! gfc_add_modify (&tmpblock, sym->ts.u.cl->backend_decl, ! fold_convert (TREE_TYPE (sym->ts.u.cl->backend_decl), ! tmp)); ! } ! ! /* Check that the argument is present before executing the above. */ ! incoming = build3_v (COND_EXPR, present, ! gfc_finish_block (&tmpblock), ! build_empty_stmt (input_location)); ! gfc_add_expr_to_block (&outer_block, incoming); ! incoming = gfc_finish_block (&outer_block); ! ! /* Convert the gfc descriptor back to the CFI type before going ! out of scope, if the CFI type was present at entry. */ ! gfc_init_block (&outer_block); ! gfc_init_block (&tmpblock); ! tmp = gfc_build_addr_expr (ppvoid_type_node, CFI_desc_ptr); outgoing = build_call_expr_loc (input_location, gfor_fndecl_gfc_to_cfi, 2, tmp, gfc_desc_ptr); gfc_add_expr_to_block (&tmpblock, outgoing); ! ! outgoing = build3_v (COND_EXPR, present, ! gfc_finish_block (&tmpblock), ! build_empty_stmt (input_location)); ! gfc_add_expr_to_block (&outer_block, outgoing); ! outgoing = gfc_finish_block (&outer_block); /* Add the lot to the procedure init and finally blocks. */ gfc_add_init_cleanup (block, incoming, outgoing); *************** gfc_trans_deferred_vars (gfc_symbol * pr *** 4923,4931 **** for (f = gfc_sym_get_dummy_args (proc_sym); f; f = f->next) { ! if (f->sym && f->sym->tlink == NULL && f->sym->ts.type == BT_CHARACTER) { - gcc_assert (f->sym->ts.u.cl->backend_decl != NULL); if (TREE_CODE (f->sym->ts.u.cl->backend_decl) == PARM_DECL) gfc_trans_vla_type_sizes (f->sym, &tmpblock); } --- 4958,4966 ---- for (f = gfc_sym_get_dummy_args (proc_sym); f; f = f->next) { ! if (f->sym && f->sym->tlink == NULL && f->sym->ts.type == BT_CHARACTER ! && f->sym->ts.u.cl->backend_decl) { if (TREE_CODE (f->sym->ts.u.cl->backend_decl) == PARM_DECL) gfc_trans_vla_type_sizes (f->sym, &tmpblock); } Index: gcc/fortran/trans-expr.c =================================================================== *** gcc/fortran/trans-expr.c (revision 270622) --- gcc/fortran/trans-expr.c (working copy) *************** gfc_conv_gfc_desc_to_cfi_desc (gfc_se *p *** 5006,5011 **** --- 5006,5012 ---- if (e->rank != 0) { + parmse->force_no_tmp = 1; if (fsym->attr.contiguous && !gfc_is_simply_contiguous (e, false, true)) gfc_conv_subref_array_arg (parmse, e, false, fsym->attr.intent, Index: gcc/fortran/trans.c =================================================================== *** gcc/fortran/trans.c (revision 270622) --- gcc/fortran/trans.c (working copy) *************** get_array_span (tree type, tree decl) *** 290,297 **** { tree span; /* Return the span for deferred character length array references. */ ! if (type && TREE_CODE (type) == ARRAY_TYPE && TYPE_MAX_VALUE (TYPE_DOMAIN (type)) != NULL_TREE && (VAR_P (TYPE_MAX_VALUE (TYPE_DOMAIN (type))) || TREE_CODE (TYPE_MAX_VALUE (TYPE_DOMAIN (type))) == INDIRECT_REF) --- 290,305 ---- { tree span; + if (TREE_CODE (decl) == COMPONENT_REF + && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl))) + return gfc_conv_descriptor_span_get (decl); + else if (TREE_CODE (decl) == INDIRECT_REF + && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl))) + return gfc_conv_descriptor_span_get (decl); + /* Return the span for deferred character length array references. */ ! if (TREE_CODE (decl) != INDIRECT_REF ! && type && TREE_CODE (type) == ARRAY_TYPE && TYPE_MAX_VALUE (TYPE_DOMAIN (type)) != NULL_TREE && (VAR_P (TYPE_MAX_VALUE (TYPE_DOMAIN (type))) || TREE_CODE (TYPE_MAX_VALUE (TYPE_DOMAIN (type))) == INDIRECT_REF) *************** get_array_span (tree type, tree decl) *** 307,313 **** TYPE_SIZE_UNIT (TREE_TYPE (type))), span); } ! else if (type && TREE_CODE (type) == ARRAY_TYPE && TYPE_MAX_VALUE (TYPE_DOMAIN (type)) != NULL_TREE && integer_zerop (TYPE_MAX_VALUE (TYPE_DOMAIN (type)))) { --- 315,322 ---- TYPE_SIZE_UNIT (TREE_TYPE (type))), span); } ! else if (TREE_CODE (decl) != INDIRECT_REF ! && type && TREE_CODE (type) == ARRAY_TYPE && TYPE_MAX_VALUE (TYPE_DOMAIN (type)) != NULL_TREE && integer_zerop (TYPE_MAX_VALUE (TYPE_DOMAIN (type)))) { *************** gfc_build_array_ref (tree base, tree off *** 399,410 **** if (vptr) span = gfc_vptr_size_get (vptr); else if (decl) ! { ! if (TREE_CODE (decl) == COMPONENT_REF) ! span = gfc_conv_descriptor_span_get (decl); ! else ! span = get_array_span (type, decl); ! } /* If a non-null span has been generated reference the element with pointer arithmetic. */ --- 408,414 ---- if (vptr) span = gfc_vptr_size_get (vptr); else if (decl) ! span = get_array_span (type, decl); /* If a non-null span has been generated reference the element with pointer arithmetic. */ Index: gcc/fortran/trans.h =================================================================== *** gcc/fortran/trans.h (revision 270622) --- gcc/fortran/trans.h (working copy) *************** typedef struct gfc_se *** 91,96 **** --- 91,99 ---- args alias. */ unsigned force_tmp:1; + /* If set, will pass subref descriptors without a temporary. */ + unsigned force_no_tmp:1; + /* Unconditionally calculate offset for array segments and constant arrays in gfc_conv_expr_descriptor. */ unsigned use_offset:1; Index: gcc/testsuite/gfortran.dg/ISO_Fortran_binding_12.c =================================================================== *** gcc/testsuite/gfortran.dg/ISO_Fortran_binding_12.c (nonexistent) --- gcc/testsuite/gfortran.dg/ISO_Fortran_binding_12.c (working copy) *************** *** 0 **** --- 1,29 ---- + /* Test the fix for PR90093. */ + + #include <stdio.h> + #include <math.h> + #include "../../../libgfortran/ISO_Fortran_binding.h" + + /* Contributed by Reinhold Bader <ba...@lrz.de> */ + + void foo_opt(CFI_cdesc_t *, float *, int *, int); + void write_res(); + + float x[34]; + + int main() { + CFI_CDESC_T(1) xd; + CFI_index_t ext[] = {34}; + int sz; + + CFI_establish((CFI_cdesc_t *) &xd, &x, CFI_attribute_other, + CFI_type_float, 0, 1, ext); + + foo_opt((CFI_cdesc_t *) &xd, NULL, NULL, 0); + sz = 12; + foo_opt(NULL, &x[11], &sz, 1); + + write_res(); + + return 0; + } Index: gcc/testsuite/gfortran.dg/ISO_Fortran_binding_12.f90 =================================================================== *** gcc/testsuite/gfortran.dg/ISO_Fortran_binding_12.f90 (nonexistent) --- gcc/testsuite/gfortran.dg/ISO_Fortran_binding_12.f90 (working copy) *************** *** 0 **** --- 1,53 ---- + ! { dg-do run { target c99_runtime } } + ! { dg-additional-sources ISO_Fortran_binding_12.c } + ! + ! Test the fix for PR90093. The additional source is the main program. + ! + ! Contributed by Reinhold Bader <ba...@lrz.de> + ! + module mod_optional + use, intrinsic :: iso_c_binding + implicit none + integer :: status = 0 + + contains + + subroutine foo_opt(this, that, sz, flag) bind(c) + real(c_float), optional :: this(:) + real(c_float), optional :: that(*) + integer(c_int), optional :: sz + integer(c_int), value :: flag + if (flag == 0) then + if (.not. present(this) .or. present(that) .or. present(sz)) then + write(*,*) 'FAIL 1', present(this), present(that), present(sz) + status = status + 1 + end if + else if (flag == 1) then + if (present(this) .or. .not. present(that) .or. .not. present(sz)) then + write(*,*) 'FAIL 2', present(this), present(that), present(sz) + status = status + 1 + end if + if (sz /= 12) then + write(*,*) 'FAIL 3' + status = status + 1 + end if + else if (flag == 2) then + if (present(this) .or. present(that) .or. present(sz)) then + write(*,*) 'FAIL 4', present(this), present(that), present(sz) + status = status + 1 + end if + end if + end subroutine foo_opt + + subroutine write_res() BIND(C) + ! Add a check that the fortran missing optional is accepted by the + ! bind(C) procedure. + call foo_opt (flag = 2) + if (status == 0) then + write(*,*) 'OK' + else + stop 1 + end if + end subroutine + + end module mod_optional Index: gcc/testsuite/gfortran.dg/ISO_Fortran_binding_4.f90 =================================================================== *** gcc/testsuite/gfortran.dg/ISO_Fortran_binding_4.f90 (revision 270622) --- gcc/testsuite/gfortran.dg/ISO_Fortran_binding_4.f90 (working copy) *************** *** 1,29 **** ! { dg-do run } ! PR fortran/89384 - this used to give a wrong results ! with contiguous. ! Test case by Reinhold Bader. module mod_ctg implicit none contains subroutine ctg(x) BIND(C) real, contiguous :: x(:) ! ! if (any(abs(x - [2.,4.,6.]) > 1.e-6)) then ! write(*,*) 'FAIL' ! stop 1 ! else ! write(*,*) 'OK' ! end if x = [2.,4.,6.]*10.0 end subroutine end module program p use mod_ctg implicit none real :: x(6) integer :: i x = [ (real(i), i=1, size(x)) ] call ctg(x(2::2)) ! if (any (abs (x - [1.,20.,3.,40.,5.,60.]) > 1.e-6)) stop 2 end program --- 1,41 ---- ! { dg-do run } ! PR fortran/89384 - this used to give a wrong results ! with contiguous. + ! The subroutine substr is a test to check a problem found while + ! debugging PR90355. + ! ! Test case by Reinhold Bader. + ! module mod_ctg implicit none + contains + subroutine ctg(x) BIND(C) real, contiguous :: x(:) ! if (any(abs(x - [2.,4.,6.]) > 1.e-6)) stop 1 x = [2.,4.,6.]*10.0 end subroutine + + subroutine substr(str) BIND(C) + character(*) :: str(:) + if (str(2) .ne. "ghi") stop 2 + str = ['uvw','xyz'] + end subroutine + end module + program p use mod_ctg implicit none real :: x(6) + character(5) :: str(2) = ['abcde','fghij'] integer :: i x = [ (real(i), i=1, size(x)) ] call ctg(x(2::2)) ! if (any (abs (x - [1.,20.,3.,40.,5.,60.]) > 1.e-6)) stop 3 ! ! call substr(str(:)(2:4)) ! if (any (str .ne. ['auvwe','fxyzj'])) stop 4 end program Index: gcc/testsuite/gfortran.dg/assign_10.f90 =================================================================== *** gcc/testsuite/gfortran.dg/assign_10.f90 (revision 270622) --- gcc/testsuite/gfortran.dg/assign_10.f90 (working copy) *************** end *** 24,27 **** ! Note that it is the kind conversion that generates the temp. ! ! { dg-final { scan-tree-dump-times "parm" 20 "original" } } ! ! { dg-final { scan-tree-dump-times "atmp" 18 "original" } } --- 24,27 ---- ! Note that it is the kind conversion that generates the temp. ! ! { dg-final { scan-tree-dump-times "parm" 20 "original" } } ! ! { dg-final { scan-tree-dump-times "atmp" 20 "original" } } Index: gcc/testsuite/gfortran.dg/iso_c_binding_char_1.f90 =================================================================== *** gcc/testsuite/gfortran.dg/iso_c_binding_char_1.f90 (nonexistent) --- gcc/testsuite/gfortran.dg/iso_c_binding_char_1.f90 (working copy) *************** *** 0 **** --- 1,10 ---- + ! { dg-do compile } + ! + ! Test the fix for PR90352. + ! + ! Contributed by Thomas Koenig <tkoe...@gcc.gnu.org> + ! + subroutine bar(c,d) BIND(C) + character (len=*) c ! { dg-error "must be length 1" } + character (len=2) d ! { dg-error "must be length 1" } + end Index: gcc/testsuite/gfortran.dg/transpose_optimization_2.f90 =================================================================== *** gcc/testsuite/gfortran.dg/transpose_optimization_2.f90 (revision 270622) --- gcc/testsuite/gfortran.dg/transpose_optimization_2.f90 (working copy) *************** end *** 61,64 **** ! The check below for temporaries gave 14 and 33 for "parm" and "atmp". ! ! { dg-final { scan-tree-dump-times "parm" 72 "original" } } ! ! { dg-final { scan-tree-dump-times "atmp" 12 "original" } } --- 61,64 ---- ! The check below for temporaries gave 14 and 33 for "parm" and "atmp". ! ! { dg-final { scan-tree-dump-times "parm" 72 "original" } } ! ! { dg-final { scan-tree-dump-times "atmp" 13 "original" } }