trans.h (gfc_conv_cray_pointee): Remove.

	* trans.h (gfc_conv_cray_pointee): Remove.
	* trans-expr.c (gfc_conv_variable): Revert 2005-10-24 change.
	* trans-array.c (gfc_conv_array_parameter): Likewise.
	* trans-decl.c (gfc_conv_cray_pointee): Remove.
	(gfc_finish_cray_pointee): New function.
	(gfc_finish_var_decl): Use it.  Don't return early for Cray
	pointees.
	(gfc_create_module_variable): Revert 2005-10-24 change.
	* decl.c (cray_pointer_decl): Update comment.
	* gfortran.texi: Don't mention Cray pointees aren't visible in the
	debugger.

	* symbol.c (check_conflict): Add conflict between cray_pointee
	and in_common resp. in_equivalence.
	* resolve.c (resolve_equivalence): Revert 2005-10-24 change.
testsuite/
	* gfortran.dg/cray_pointers_4.f90: New test.

	* module.c (ab_attribute): Add AB_CRAY_POINTER and AB_CRAY_POINTEE.
	(attr_bits): Likewise.
	(mio_symbol_attribute): Save and restore cray_pointe{r,e} attributes.
	(mio_symbol): For cray_pointee write/read cp_pointer reference.
testsuite/
	* gfortran.dg/cray_pointers_5.f90: New test.

From-SVN: r105891

gcc/fortran/decl.c

@@ -2995,8 +2995,7 @@ attr_decl (void)
    pointer (ipt, ar(10))
    any subsequent uses of ar will be translated (in C-notation) as
    ar(i) => ((<type> *) ipt)(i)   
-   By the time the code is translated into GENERIC, the pointee will
-   have disappeared from the code entirely. */
+   After gimplification, pointee variable will disappear in the code.  */
 
 static match
 cray_pointer_decl (void)
@@ -3112,7 +3111,7 @@ cray_pointer_decl (void)
 	} 
    
       /* Point the Pointee at the Pointer.  */
-      cpte->cp_pointer=cptr;
+      cpte->cp_pointer = cptr;
 
       if (gfc_match_char (')') != MATCH_YES)
 	{

gcc/fortran/gfortran.texi

@@ -899,11 +899,7 @@ expect.  Adding 1 to ipt just adds one byte to the address stored in
 ipt.
 
 Any expression involving the pointee will be translated to use the
-value stored in the pointer as the base address.  This translation is
-done in the front end, and so the pointees are not present in the
-GENERIC tree that is handed off to the backend.  One disadvantage of
-this is that pointees will not appear in gdb when debugging a Fortran
-program that uses Cray pointers.
+value stored in the pointer as the base address.
 
 To get the address of elements, this extension provides an intrinsic
 function loc(), loc() is essentially the C '&' operator, except the

gcc/fortran/module.c

@@ -1431,7 +1431,8 @@ typedef enum
   AB_POINTER, AB_SAVE, AB_TARGET, AB_DUMMY, AB_RESULT,
   AB_DATA, AB_IN_NAMELIST, AB_IN_COMMON, 
   AB_FUNCTION, AB_SUBROUTINE, AB_SEQUENCE, AB_ELEMENTAL, AB_PURE,
-  AB_RECURSIVE, AB_GENERIC, AB_ALWAYS_EXPLICIT
+  AB_RECURSIVE, AB_GENERIC, AB_ALWAYS_EXPLICIT, AB_CRAY_POINTER,
+  AB_CRAY_POINTEE
 }
 ab_attribute;
 
@@ -1458,6 +1459,8 @@ static const mstring attr_bits[] =
     minit ("RECURSIVE", AB_RECURSIVE),
     minit ("GENERIC", AB_GENERIC),
     minit ("ALWAYS_EXPLICIT", AB_ALWAYS_EXPLICIT),
+    minit ("CRAY_POINTER", AB_CRAY_POINTER),
+    minit ("CRAY_POINTEE", AB_CRAY_POINTEE),
     minit (NULL, -1)
 };
 
@@ -1542,6 +1545,10 @@ mio_symbol_attribute (symbol_attribute * attr)
 	MIO_NAME(ab_attribute) (AB_RECURSIVE, attr_bits);
       if (attr->always_explicit)
         MIO_NAME(ab_attribute) (AB_ALWAYS_EXPLICIT, attr_bits);
+      if (attr->cray_pointer)
+	MIO_NAME(ab_attribute) (AB_CRAY_POINTER, attr_bits);
+      if (attr->cray_pointee)
+	MIO_NAME(ab_attribute) (AB_CRAY_POINTEE, attr_bits);
 
       mio_rparen ();
 
@@ -1622,6 +1629,12 @@ mio_symbol_attribute (symbol_attribute * attr)
             case AB_ALWAYS_EXPLICIT:
               attr->always_explicit = 1;
               break;
+	    case AB_CRAY_POINTER:
+	      attr->cray_pointer = 1;
+	      break;
+	    case AB_CRAY_POINTEE:
+	      attr->cray_pointee = 1;
+	      break;
 	    }
 	}
     }
@@ -2815,6 +2828,9 @@ mio_symbol (gfc_symbol * sym)
 
   mio_symbol_ref (&sym->result);
 
+  if (sym->attr.cray_pointee)
+    mio_symbol_ref (&sym->cp_pointer);
+
   /* Note that components are always saved, even if they are supposed
      to be private.  Component access is checked during searching.  */
 

gcc/fortran/resolve.c

@@ -5177,14 +5177,6 @@ resolve_equivalence (gfc_equiv *eq)
           break;
         }
  
-     /* Shall not be a Cray pointee.  */
-      if (sym->attr.cray_pointee)
-        {
-          gfc_error ("Cray Pointee '%s' at %L cannot be an EQUIVALENCE "
-		     "object", sym->name, &e->where);
-          continue;
-        }
-
       /* Shall not be a named constant.  */      
       if (e->expr_type == EXPR_CONSTANT)
         {

gcc/fortran/symbol.c

@@ -368,6 +368,8 @@ check_conflict (symbol_attribute * attr, const char * name, locus * where)
   conf (cray_pointee, function);
   conf (cray_pointee, subroutine);
   conf (cray_pointee, entry);
+  conf (cray_pointee, in_common);
+  conf (cray_pointee, in_equivalence);
 
   a1 = gfc_code2string (flavors, attr->flavor);
 

gcc/fortran/trans-array.c

@@ -4083,13 +4083,8 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, gfc_ss * ss, int g77)
        && expr->ref->u.ar.type == AR_FULL && g77)
     {
       sym = expr->symtree->n.sym;
+      tmp = gfc_get_symbol_decl (sym);
 
-      /* Check to see if we're dealing with a Cray Pointee.  */
-      if (sym->attr.cray_pointee)
-	tmp = gfc_conv_cray_pointee (sym);
-      else
-	tmp = gfc_get_symbol_decl (sym);
-      
       if (sym->ts.type == BT_CHARACTER)
 	se->string_length = sym->ts.cl->backend_decl;
       if (!sym->attr.pointer && sym->as->type != AS_ASSUMED_SHAPE 

gcc/fortran/trans-decl.c

@@ -351,6 +351,44 @@ gfc_can_put_var_on_stack (tree size)
 }
 
 
+/* gfc_finish_cray_pointee sets DECL_VALUE_EXPR for a Cray pointee to
+   an expression involving its corresponding pointer.  There are
+   2 cases; one for variable size arrays, and one for everything else,
+   because variable-sized arrays require one fewer level of
+   indirection.  */
+
+static void
+gfc_finish_cray_pointee (tree decl, gfc_symbol *sym)
+{
+  tree ptr_decl = gfc_get_symbol_decl (sym->cp_pointer);
+  tree value;
+
+  /* Parameters need to be dereferenced.  */
+  if (sym->cp_pointer->attr.dummy) 
+    ptr_decl = gfc_build_indirect_ref (ptr_decl);
+
+  /* Check to see if we're dealing with a variable-sized array.  */
+  if (sym->attr.dimension
+      && TREE_CODE (TREE_TYPE (decl)) == POINTER_TYPE) 
+    {  
+      /* These decls will be derefenced later, so we don't dereference
+	 them here.  */
+      value = convert (TREE_TYPE (decl), ptr_decl);
+    }
+  else
+    {
+      ptr_decl = convert (build_pointer_type (TREE_TYPE (decl)),
+			  ptr_decl);
+      value = gfc_build_indirect_ref (ptr_decl);
+    }
+
+  SET_DECL_VALUE_EXPR (decl, value);
+  DECL_HAS_VALUE_EXPR_P (decl) = 1;
+  /* This is a fake variable just for debugging purposes.  */
+  TREE_ASM_WRITTEN (decl) = 1;
+}
+
+
 /* Finish processing of a declaration and install its initial value.  */
 
 static void
@@ -417,9 +455,9 @@ gfc_finish_var_decl (tree decl, gfc_symbol * sym)
      We also need to set this if the variable is passed by reference in a
      CALL statement.  */
 
-  /* We don't want real declarations for Cray Pointees.  */
+  /* Set DECL_VALUE_EXPR for Cray Pointees.  */
   if (sym->attr.cray_pointee)
-    return;
+    gfc_finish_cray_pointee (decl, sym);
 
   if (sym->attr.target)
     TREE_ADDRESSABLE (decl) = 1;
@@ -437,6 +475,9 @@ gfc_finish_var_decl (tree decl, gfc_symbol * sym)
 	gfc_add_decl_to_parent_function (decl);
     }
 
+  if (sym->attr.cray_pointee)
+    return;
+
   /* If a variable is USE associated, it's always external.  */
   if (sym->attr.use_assoc)
     {
@@ -2309,10 +2350,6 @@ gfc_create_module_variable (gfc_symbol * sym)
   /* Create the decl.  */
   decl = gfc_get_symbol_decl (sym);
 
-  /* Don't create a "real" declaration for a Cray Pointee.  */
-  if (sym->attr.cray_pointee)
-    return;
-
   /* Create the variable.  */
   pushdecl (decl);
   rest_of_decl_compilation (decl, 1, 0);
@@ -2734,36 +2771,5 @@ gfc_generate_block_data (gfc_namespace * ns)
   rest_of_decl_compilation (decl, 1, 0);
 }
 
-/* gfc_conv_cray_pointee takes a sym with attribute cray_pointee and
-   swaps in the backend_decl of its corresponding pointer.  There are
-   2 cases; one for variable size arrays, and one for everything else,
-   because variable-sized arrays require one fewer level of
-   indirection.  */
-
-tree
-gfc_conv_cray_pointee(gfc_symbol *sym)
-{
-  tree decl = gfc_get_symbol_decl (sym->cp_pointer);
-
-  /* Parameters need to be dereferenced.  */
-  if (sym->cp_pointer->attr.dummy) 
-    decl = gfc_build_indirect_ref (decl);
-
-  /* Check to see if we're dealing with a variable-sized array.  */
-  if (sym->attr.dimension
-      && TREE_CODE (TREE_TYPE (sym->backend_decl)) == POINTER_TYPE) 
-    {  
-      /* These decls will be derefenced later, so we don't dereference
-	 them here.  */
-      decl = convert (TREE_TYPE (sym->backend_decl), decl);
-    }
-  else
-    {
-      decl = convert (build_pointer_type (TREE_TYPE (sym->backend_decl)),
-		      decl);
-      decl = gfc_build_indirect_ref (decl);
-    }
-  return decl;
-}
 
 #include "gt-fortran-trans-decl.h"

gcc/fortran/trans-expr.c

@@ -316,11 +316,7 @@ gfc_conv_variable (gfc_se * se, gfc_expr * expr)
     {
       tree se_expr = NULL_TREE;
 
-      /* Handle Cray Pointees.  */
-      if (sym->attr.cray_pointee)
-	se->expr = gfc_conv_cray_pointee (sym);
-      else
-	se->expr = gfc_get_symbol_decl (sym);
+      se->expr = gfc_get_symbol_decl (sym);
 
       /* Special case for assigning the return value of a function.
 	 Self recursive functions must have an explicit return value.  */

gcc/fortran/trans.h

@@ -406,9 +406,6 @@ void gfc_generate_block_data (gfc_namespace *);
 /* Output a decl for a module variable.  */
 void gfc_generate_module_vars (gfc_namespace *);
 
-/* Translate the declaration for a Cray Pointee.  */
-tree gfc_conv_cray_pointee (gfc_symbol *sym);
-
 /* Get and set the current location.  */
 void gfc_set_backend_locus (locus *);
 void gfc_get_backend_locus (locus *);

gcc/testsuite/ChangeLog

+2005-10-25  Jakub Jelinek  <jakub@redhat.com>
+
+	* gfortran.dg/cray_pointers_4.f90: New test.
+
+	* gfortran.dg/cray_pointers_5.f90: New test.
+
 2005-10-25  Feng Wang  <fengwang@nudt.edu.cn>
 
 	PR fortran/22290

gcc/testsuite/gfortran.dg/cray_pointers_4.f90

+! { dg-do compile }
+! { dg-options "-fcray-pointer" }
+
+subroutine err1
+  integer :: in_common1, in_common2, v, w, equiv1, equiv2
+  common /in_common1/ in_common1
+  pointer (ipt1, in_common1)		! { dg-error "conflicts with COMMON" }
+  pointer (ipt2, in_common2)
+  common /in_common2/ in_common2	! { dg-error "conflicts with COMMON" }
+  equivalence (v, equiv1)
+  pointer (ipt3, equiv1)		! { dg-error "conflicts with EQUIVALENCE" }
+  pointer (ipt4, equiv2)
+  equivalence (w, equiv2)		! { dg-error "conflicts with EQUIVALENCE" }
+end subroutine err1

gcc/testsuite/gfortran.dg/cray_pointers_5.f90

+! { dg-do run }
+! { dg-options "-fcray-pointer -fno-strict-aliasing" }
+
+module cray_pointers_5
+  integer :: var (10), arr(100)
+  pointer (ipt, var)
+end module cray_pointers_5
+
+  use cray_pointers_5
+  integer :: i
+
+  forall (i = 1:100) arr(i) = i
+  ipt = loc (arr)
+  if (any (var .ne. (/1, 2, 3, 4, 5, 6, 7, 8, 9, 10/))) call abort
+end