Patchwork [Fortran] PR 43665 -- add fn-spec annotation based on INTENT settings

login
register
mail settings
Submitter Tobias Burnus
Date Sept. 6, 2010, 6:48 p.m.
Message ID <4C853769.5080406@net-b.de>
Download mbox | patch
Permalink /patch/63954/
State New
Headers show

Comments

Tobias Burnus - Sept. 6, 2010, 6:48 p.m.
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.

I will regtest the patch after Martin's patch is in. Assuming no failures:
OK for the trunk?

Tobias
Tobias Burnus - Sept. 7, 2010, 6:58 p.m.
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
Mikael Morin - Sept. 7, 2010, 10:27 p.m.
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

Patch

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" } }