symbol.c (check_conflict): Allow external, function, and subroutine attributes with Cray pointees.

2006-05-30  Asher Langton  <langton2@llnl.gov>

	* symbol.c (check_conflict): Allow external, function, and
	subroutine attributes with Cray pointees.
	* trans-expr.c (gfc_conv_function_val): Translate Cray pointees
	that point to procedures.
	* gfortran.texi: Document new feature.

	* gfortran.dg/cray_pointers_7.f90: New test.

From-SVN: r114252

gcc/fortran/ChangeLog

+2006-05-30  Asher Langton  <langton2@llnl.gov>
+
+	* symbol.c (check_conflict): Allow external, function, and
+	subroutine attributes with Cray pointees.
+	* trans-expr.c (gfc_conv_function_val): Translate Cray pointees
+	that point to procedures.
+	* gfortran.texi: Document new feature.
+
 2006-05-29  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
 	PR fortran/27634

gcc/fortran/gfortran.texi

@@ -1107,13 +1107,28 @@ pointers will ``incorrectly'' optimize code with illegal aliasing.)
 
 There are a number of restrictions on the attributes that can be
 applied to Cray pointers and pointees.  Pointees may not have the
-attributes ALLOCATABLE, INTENT, OPTIONAL, DUMMY, TARGET, EXTERNAL,
+attributes ALLOCATABLE, INTENT, OPTIONAL, DUMMY, TARGET,
 INTRINSIC, or POINTER.  Pointers may not have the attributes
 DIMENSION, POINTER, TARGET, ALLOCATABLE, EXTERNAL, or INTRINSIC.
 Pointees may not occur in more than one pointer statement.  A pointee
 cannot be a pointer.  Pointees cannot occur in equivalence, common, or
 data statements.
 
+A Cray pointer may point to a function or a subroutine.  For example,
+the following excerpt is valid:
+@smallexample
+  implicit none
+  external sub
+  pointer (subptr,subpte)
+  external subpte
+  subptr = loc(sub)
+  call subpte()
+  [...]
+  subroutine sub
+  [...]
+  end subroutine sub
+@end smallexample
+
 A pointer may be modified during the course of a program, and this
 will change the location to which the pointee refers.  However, when
 pointees are passed as arguments, they are treated as ordinary

gcc/fortran/symbol.c

@@ -385,11 +385,8 @@ check_conflict (symbol_attribute * attr, const char * name, locus * where)
   conf (cray_pointee, optional);
   conf (cray_pointee, dummy);
   conf (cray_pointee, target);
-  conf (cray_pointee, external);
   conf (cray_pointee, intrinsic);
   conf (cray_pointee, pointer);
-  conf (cray_pointee, function);
-  conf (cray_pointee, subroutine);
   conf (cray_pointee, entry);
   conf (cray_pointee, in_common);
   conf (cray_pointee, in_equivalence);

gcc/fortran/trans-expr.c

@@ -1191,6 +1191,9 @@ gfc_conv_function_val (gfc_se * se, gfc_symbol * sym)
 	sym->backend_decl = gfc_get_extern_function_decl (sym);
 
       tmp = sym->backend_decl;
+      if (sym->attr.cray_pointee)
+	tmp = convert (build_pointer_type (TREE_TYPE (tmp)),
+		       gfc_get_symbol_decl (sym->cp_pointer));
       if (!POINTER_TYPE_P (TREE_TYPE (tmp)))
 	{
 	  gcc_assert (TREE_CODE (tmp) == FUNCTION_DECL);

gcc/testsuite/ChangeLog

+2006-05-30  Asher Langton  <langton2@llnl.gov>
+
+	* gfortran.dg/cray_pointers_7.f90: New test.
+
 2006-05-30  Roger Sayle  <roger@eyesopen.com>
 
 	PR tree-optimization/23452

gcc/testsuite/gfortran.dg/cray_pointers_7.f90

+! { dg-do run }
+! { dg-options "-fcray-pointer" }
+
+! Test the implementation of Cray pointers to procedures.
+program cray_pointers_7
+  implicit none
+  integer tmp
+  integer, external :: fn
+  external sub
+  
+  ! We can't mix function and subroutine pointers.
+  pointer (subptr,subpte)
+  pointer (fnptr,fnpte)
+  
+  ! Declare pointee types.
+  external subpte
+  integer, external :: fnpte
+  
+  tmp = 0
+  
+  ! Check pointers to subroutines.
+  subptr = loc(sub)
+  call subpte(tmp)
+  if (tmp .ne. 17) call abort()
+
+  ! Check pointers to functions.
+  fnptr = loc(fn)
+  tmp = fnpte(7)
+  if (tmp .ne. 14) call abort()
+  
+end program cray_pointers_7
+
+! Trivial subroutine to be called through a Cray pointer.
+subroutine sub(i)
+  integer i
+  i = 17
+end subroutine sub
+
+! Trivial function to be called through a Cray pointer.
+function fn(i)
+  integer fn,i
+  fn = 2*i
+end function fn