| Message ID | 4C853769.5080406@net-b.de |
|---|---|
| State | New |
| Headers | show |
Tobias Burnus wrote: > The following patch requires Martin's patch (attached to the PR) or > the option -fno-ipa-cp.as otherwise the argument removal can cause > wrong code. Martin's patch is now in - and in principle this patch can get in. Thus, I would like if someone could review this patch. However, ... > I will regtest the patch after Martin's patch is in. Assuming no > failures: Actually there are failures: gfortran.dg/cray_pointers_2.f90 fails with -O3 and gfortran.dg/fgetc_2.f90 with -O1. I have only looked at the latter. It fails because in st = fgetc(10,s) if (s(1:1) /= "1") call abort st = fgetc(10,s) if (s(1:1) /= "2") call abort The second "call abort()" is executed unconditionally. That makes sense if one looks at intrinsics.c: add_sym_2 ("fputc", ... where add_sym_2 calls: add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf, a1, type1, kind1, optional1, INTENT_IN, a2, type2, kind2, optional2, INTENT_IN, (void *) 0); Note the INTENT_IN! Thus, optimizing the 's(1:1) /= "2"' check away makes sense. However, that means that before this patch can get in, one needs to audit the intrinsics and update the intents. Therefore: I would be delighted if someone could review the trans-decl.c part of this patch; however, I plan to send an updated patch with unchanged/review fixed trans-decl.c and intrinsic.c fixes. Tobias
Le 07.09.2010 20:58, Tobias Burnus a écrit : > > Tobias Burnus wrote: >> The following patch requires Martin's patch (attached to the PR) or >> the option -fno-ipa-cp.as otherwise the argument removal can cause >> wrong code. > > Martin's patch is now in - and in principle this patch can get in. Thus, > I would like if someone could review this patch. However, ... > >> I will regtest the patch after Martin's patch is in. Assuming no >> failures: > > Actually there are failures: gfortran.dg/cray_pointers_2.f90 fails with > -O3 and gfortran.dg/fgetc_2.f90 with -O1. I have only looked at the > latter. It fails because in > > st = fgetc(10,s) > if (s(1:1) /= "1") call abort > st = fgetc(10,s) > if (s(1:1) /= "2") call abort > > The second "call abort()" is executed unconditionally. That makes sense > if one looks at intrinsics.c: > add_sym_2 ("fputc", ... > where add_sym_2 calls: > add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf, > a1, type1, kind1, optional1, INTENT_IN, > a2, type2, kind2, optional2, INTENT_IN, > (void *) 0); > > Note the INTENT_IN! Thus, optimizing the 's(1:1) /= "2"' check away > makes sense. However, that means that before this patch can get in, one > needs to audit the intrinsics and update the intents. > > Therefore: I would be delighted if someone could review the trans-decl.c > part of this patch; however, I plan to send an updated patch with > unchanged/review fixed trans-decl.c and intrinsic.c fixes. > > Tobias > Hello, the trans-decl.c part is OK. I'm just wondering why you don't call gfc_create_fn_spec from gfc_get_function_type directly. Are there cases where you don't want the fn spec ? Mikael
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 5932695..b5ca814 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -1395,6 +1395,51 @@ get_proc_pointer_decl (gfc_symbol *sym) } +/* Create a "fn spec" based on the formal arguments; + cf. create_function_arglist. */ + +static tree +create_fn_spec (gfc_symbol *sym, tree fntype) +{ + char spec[150]; + size_t spec_len; + gfc_formal_arglist *f; + tree tmp; + + memset (&spec, 0, sizeof (spec)); + spec[0] = '.'; + spec_len = 1; + + if (sym->attr.entry_master) + spec[spec_len++] = 'R'; + if (gfc_return_by_reference (sym)) + { + if (sym->result->attr.pointer) + spec[spec_len++] = '.'; + else + spec[spec_len++] = 'w'; + if (sym->ts.type == BT_CHARACTER) + spec[spec_len++] = 'R'; + } + + for (f = sym->formal; f; f = f->next) + if (spec_len < sizeof (spec)) + { + if (!f->sym || f->sym->attr.pointer || f->sym->attr.target + || f->sym->attr.external) + spec[spec_len++] = '.'; + else if (f->sym->attr.intent == INTENT_IN) + spec[spec_len++] = 'r'; + else if (f->sym) + spec[spec_len++] = 'w'; + } + + tmp = build_tree_list (NULL_TREE, build_string (spec_len, spec)); + tmp = tree_cons (get_identifier ("fn spec"), tmp, TYPE_ATTRIBUTES (fntype)); + return build_type_attribute_variant (fntype, tmp); +} + + /* Get a basic decl for an external function. */ tree @@ -1534,6 +1579,8 @@ gfc_get_extern_function_decl (gfc_symbol * sym) } type = gfc_get_function_type (sym); + if (sym->formal) + type = create_fn_spec (sym, type); fndecl = build_decl (input_location, FUNCTION_DECL, name, type); @@ -1613,6 +1660,7 @@ build_function_decl (gfc_symbol * sym) == NAMESPACE_DECL); type = gfc_get_function_type (sym); + type = create_fn_spec (sym, type); fndecl = build_decl (input_location, FUNCTION_DECL, gfc_sym_identifier (sym), type); --- /dev/null 2010-07-20 08:01:57.395357453 +0200 +++ b/gcc/testsuite/gfortran.dg/intent_optimize_1.f90 2010-07-20 16:19:59.000000000 +0200 @@ -0,0 +1,24 @@ +! { dg-do compile } +! { dg-options "-O2 -fdump-tree-optimized" } +! +! Check whether the "does_not_exist" subroutine has been +! optimized away, i.e. check that "foo"'s intent(IN) gets +! honoured. +! +! PR fortran/43665 +! +interface + subroutine foo(x) + integer, intent(in) :: x + end subroutine foo +end interface + +integer :: y + +y = 5 +call foo(y) +if (y /= 5) call does_not_exist () +end + +! { dg-final { scan-tree-dump-times "does_not_exist" 0 "optimized" } } +! { dg-final { cleanup-tree-dump "optimized" } }