OSDN Git Service

2010-09-16 Tobias Burnus <burnus@net-b.de>
authorburnus <burnus@138bc75d-0d04-0410-961f-82ee72b054a4>
Thu, 16 Sep 2010 21:30:05 +0000 (21:30 +0000)
committerburnus <burnus@138bc75d-0d04-0410-961f-82ee72b054a4>
Thu, 16 Sep 2010 21:30:05 +0000 (21:30 +0000)
        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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@164348 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/fortran/ChangeLog
gcc/fortran/trans-types.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/cray_pointers_2.f90
gcc/testsuite/gfortran.dg/intent_optimize_1.f90 [new file with mode: 0644]

index 3f97c4c..966287d 100644 (file)
@@ -1,3 +1,9 @@
+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.
index 46ddfed..7933a94 100644 (file)
@@ -2279,6 +2279,53 @@ gfc_get_mixed_entry_union (gfc_namespace *ns)
   return type;
 }
 \f
+/* 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;
 }
index 46bb71d..96955e0 100644 (file)
@@ -1,3 +1,10 @@
+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.
index 42cdf9b..8584f33 100644 (file)
@@ -1,6 +1,11 @@
 ! { 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
diff --git a/gcc/testsuite/gfortran.dg/intent_optimize_1.f90 b/gcc/testsuite/gfortran.dg/intent_optimize_1.f90
new file mode 100644 (file)
index 0000000..dbe0128
--- /dev/null
@@ -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" } }