re PR fortran/43665 (INTENT(IN) etc. optimization of calls: function annotations…

re PR fortran/43665 (INTENT(IN) etc. optimization of calls: function annotations for noclobber/noescape arguments)

2010-09-16  Tobias Burnus  <burnus@net-b.de>

        PR fortran/43665
        * trans-types.c (create_fn_spec): New function.
        (gfc_get_function_type): Call it.

2010-09-16  Tobias Burnus  <burnus@net-b.de>

        PR fortran/43665
        * gfortran.dg/cray_pointers_2.f90: Disable inlining to avoid
        optimizations.
        * gfortran.dg/intent_optimize_1.f90: New test.

From-SVN: r164348

gcc/fortran/ChangeLog

+2010-09-16  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/43665
+	* trans-types.c (create_fn_spec): New function.
+	(gfc_get_function_type): Call it.
+
 2010-09-16  Jakub Jelinek  <jakub@redhat.com>
 
 	* gfortran.h (walk_code_fn_t, walk_expr_fn_t): New types.

gcc/fortran/trans-types.c

@@ -2279,6 +2279,53 @@ gfc_get_mixed_entry_union (gfc_namespace *ns)
   return type;
 }
 
+/* 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))
+    {
+      gfc_symbol *result = sym->result ? sym->result : sym;
+
+      if (result->attr.pointer || sym->attr.proc_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 || f->sym->attr.cray_pointer)
+	  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);
+}
+
+
 tree
 gfc_get_function_type (gfc_symbol * sym)
 {
@@ -2420,6 +2467,7 @@ gfc_get_function_type (gfc_symbol * sym)
     type = gfc_sym_type (sym);
 
   type = build_function_type (type, typelist);
+  type = create_fn_spec (sym, type);
 
   return type;
 }

gcc/testsuite/ChangeLog

+2010-09-16  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/43665
+	* gfortran.dg/cray_pointers_2.f90: Disable inlining to avoid
+	optimizations.
+	* gfortran.dg/intent_optimize_1.f90: New test.
+
 2010-09-16  H.J. Lu  <hongjiu.lu@intel.com>
 
 	* gcc.target/i386/divmod-1.c: New.

gcc/testsuite/gfortran.dg/cray_pointers_2.f90

 ! { dg-do run }
-! { dg-options "-fcray-pointer -fbounds-check" }
+! { dg-options "-fcray-pointer -fbounds-check -fno-inline" }
+!
 ! Series of routines for testing a Cray pointer implementation
+!
+! Note: Some of the test cases violate Fortran's alias rules;
+! the "-fno-inline option" for now prevents failures.
+!
 program craytest
   common /errors/errors(400)
   common /foo/foo ! To prevent optimizations

gcc/testsuite/gfortran.dg/intent_optimize_1.f90

+! { 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" } }