OSDN Git Service

2010-03-17 Tobias Burnus <burnus@net-b.de>
authorburnus <burnus@138bc75d-0d04-0410-961f-82ee72b054a4>
Wed, 17 Mar 2010 09:53:40 +0000 (09:53 +0000)
committerburnus <burnus@138bc75d-0d04-0410-961f-82ee72b054a4>
Wed, 17 Mar 2010 09:53:40 +0000 (09:53 +0000)
        PR fortran/43331
        * trans-array.c (gfc_conv_array_index_offset,gfc_conv_array_ref,
        gfc_conv_ss_startstride): Remove no-longer-needed cp_was_assumed
        check.
        * decl.c (gfc_match_derived_decl): Don't mark assumed-size Cray
        pointees as having explizit size.
        * expr.c (gfc_check_assign): Remove now unreachable Cray pointee
        check.
        * trans-types.c (gfc_is_nodesc_array): Add cp_was_assumed to
        * assert.
        (gfc_sym_type): Don't mark Cray pointees as restricted pointers.
        * resolve.c (resolve_symbol): Handle cp_was_assumed.
        * trans-decl.c (gfc_trans_deferred_vars): Ditto.
        (gfc_finish_var_decl): Don't mark Cray pointees as restricted
        pointers.

2010-03-17  Tobias Burnus  <burnus@net-b.de>

        PR fortran/43331
        * gfortran.dg/cray_pointers_1.f90: Update dg-error message.

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

gcc/fortran/ChangeLog
gcc/fortran/decl.c
gcc/fortran/expr.c
gcc/fortran/resolve.c
gcc/fortran/trans-array.c
gcc/fortran/trans-decl.c
gcc/fortran/trans-types.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/cray_pointers_1.f90

index dd809d9..e445a6a 100644 (file)
@@ -1,3 +1,20 @@
+2010-03-17  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/43331
+       * trans-array.c (gfc_conv_array_index_offset,gfc_conv_array_ref,
+       gfc_conv_ss_startstride): Remove no-longer-needed cp_was_assumed
+       check.
+       * decl.c (gfc_match_derived_decl): Don't mark assumed-size Cray
+       pointees as having explizit size.
+       * expr.c (gfc_check_assign): Remove now unreachable Cray pointee
+       check.
+       * trans-types.c (gfc_is_nodesc_array): Add cp_was_assumed to assert.
+       (gfc_sym_type): Don't mark Cray pointees as restricted pointers.
+       * resolve.c (resolve_symbol): Handle cp_was_assumed.
+       * trans-decl.c (gfc_trans_deferred_vars): Ditto.
+       (gfc_finish_var_decl): Don't mark Cray pointees as restricted
+       pointers.
+
 2010-03-14  Tobias Burnus  <burnus@net-b.de>
 
        PR fortran/43362
index 0466906..692078a 100644 (file)
@@ -6969,22 +6969,14 @@ gfc_match_derived_decl (void)
 
 
 /* Cray Pointees can be declared as: 
-      pointer (ipt, a (n,m,...,*)) 
-   By default, this is treated as an AS_ASSUMED_SIZE array.  We'll
-   cheat and set a constant bound of 1 for the last dimension, if this
-   is the case. Since there is no bounds-checking for Cray Pointees,
-   this will be okay.  */
+      pointer (ipt, a (n,m,...,*))  */
 
 match
 gfc_mod_pointee_as (gfc_array_spec *as)
 {
   as->cray_pointee = true; /* This will be useful to know later.  */
   if (as->type == AS_ASSUMED_SIZE)
-    {
-      as->type = AS_EXPLICIT;
-      as->upper[as->rank - 1] = gfc_int_expr (1);
-      as->cp_was_assumed = true;
-    }
+    as->cp_was_assumed = true;
   else if (as->type == AS_ASSUMED_SHAPE)
     {
       gfc_error ("Cray Pointee at %C cannot be assumed shape array");
index 6d3ca84..58c9063 100644 (file)
@@ -3010,16 +3010,6 @@ gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue, int conform)
        }
     }
 
-   if (sym->attr.cray_pointee
-       && lvalue->ref != NULL
-       && lvalue->ref->u.ar.type == AR_FULL
-       && lvalue->ref->u.ar.as->cp_was_assumed)
-     {
-       gfc_error ("Vector assignment to assumed-size Cray Pointee at %L "
-                 "is illegal", &lvalue->where);
-       return FAILURE;
-     }
-
   /* This is possibly a typo: x = f() instead of x => f().  */
   if (gfc_option.warn_surprising 
       && rvalue->expr_type == EXPR_FUNCTION
index 774dfe4..de316da 100644 (file)
@@ -11010,7 +11010,7 @@ resolve_symbol (gfc_symbol *sym)
      arguments.  */
 
   if (sym->as != NULL
-      && (sym->as->type == AS_ASSUMED_SIZE
+      && ((sym->as->type == AS_ASSUMED_SIZE && !sym->as->cp_was_assumed)
          || sym->as->type == AS_ASSUMED_SHAPE)
       && sym->attr.dummy == 0)
     {
index 8eea3ac..5eeead8 100644 (file)
@@ -2404,8 +2404,8 @@ gfc_conv_array_index_offset (gfc_se * se, gfc_ss_info * info, int dim, int i,
 
          index = gfc_trans_array_bound_check (se, info->descriptor,
                        index, dim, &ar->where,
-                       (ar->as->type != AS_ASSUMED_SIZE
-                        && !ar->as->cp_was_assumed) || dim < ar->dimen - 1);
+                       ar->as->type != AS_ASSUMED_SIZE
+                       || dim < ar->dimen - 1);
          break;
 
        case DIMEN_VECTOR:
@@ -2431,8 +2431,8 @@ gfc_conv_array_index_offset (gfc_se * se, gfc_ss_info * info, int dim, int i,
          /* Do any bounds checking on the final info->descriptor index.  */
          index = gfc_trans_array_bound_check (se, info->descriptor,
                        index, dim, &ar->where,
-                       (ar->as->type != AS_ASSUMED_SIZE
-                        && !ar->as->cp_was_assumed) || dim < ar->dimen - 1);
+                       ar->as->type != AS_ASSUMED_SIZE
+                       || dim < ar->dimen - 1);
          break;
 
        case DIMEN_RANGE:
@@ -2581,8 +2581,7 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_symbol * sym,
 
          /* Upper bound, but not for the last dimension of assumed-size
             arrays.  */
-         if (n < ar->dimen - 1
-             || (ar->as->type != AS_ASSUMED_SIZE && !ar->as->cp_was_assumed))
+         if (n < ar->dimen - 1 || ar->as->type != AS_ASSUMED_SIZE)
            {
              tmp = gfc_conv_array_ubound (se->expr, n);
              if (sym->attr.temporary)
@@ -3207,8 +3206,7 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop)
                continue;
 
              if (dim == info->ref->u.ar.dimen - 1
-                 && (info->ref->u.ar.as->type == AS_ASSUMED_SIZE
-                     || info->ref->u.ar.as->cp_was_assumed))
+                 && info->ref->u.ar.as->type == AS_ASSUMED_SIZE)
                check_upper = false;
              else
                check_upper = true;
index 34e153a..6f5f779 100644 (file)
@@ -598,6 +598,7 @@ gfc_finish_var_decl (tree decl, gfc_symbol * sym)
 
   if (!sym->attr.target
       && !sym->attr.pointer
+      && !sym->attr.cray_pointee
       && !sym->attr.proc_pointer)
     DECL_RESTRICTED_P (decl) = 1;
 }
@@ -3159,10 +3160,11 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody)
 
            case AS_ASSUMED_SIZE:
              /* Must be a dummy parameter.  */
-             gcc_assert (sym->attr.dummy);
+             gcc_assert (sym->attr.dummy || sym->as->cp_was_assumed);
 
              /* We should always pass assumed size arrays the g77 way.  */
-             fnbody = gfc_trans_g77_array (sym, fnbody);
+             if (sym->attr.dummy)
+               fnbody = gfc_trans_g77_array (sym, fnbody);
               break;
 
            case AS_ASSUMED_SHAPE:
index 278ae27..ebe4c2f 100644 (file)
@@ -1193,7 +1193,7 @@ gfc_is_nodesc_array (gfc_symbol * sym)
   if (sym->attr.result || sym->attr.function)
     return 0;
 
-  gcc_assert (sym->as->type == AS_EXPLICIT);
+  gcc_assert (sym->as->type == AS_EXPLICIT || sym->as->cp_was_assumed);
 
   return 1;
 }
@@ -1775,7 +1775,7 @@ gfc_sym_type (gfc_symbol * sym)
     byref = 0;
 
   restricted = !sym->attr.target && !sym->attr.pointer
-               && !sym->attr.proc_pointer;
+               && !sym->attr.proc_pointer && !sym->attr.cray_pointee;
   if (sym->attr.dimension)
     {
       if (gfc_is_nodesc_array (sym))
index bd89299..bd2b05e 100644 (file)
@@ -1,3 +1,8 @@
+2010-03-17  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/43331
+       * gfortran.dg/cray_pointers_1.f90: Update dg-error message.
+
 2010-03-16  Uros Bizjak  <ubizjak@gmail.com>
 
        * gcc.dg/graphite/block-3.c: Add dg-timeout-factor.
index b23a300..87ace68 100644 (file)
@@ -21,7 +21,7 @@ subroutine err3
   real array(*)
   pointer (ipt, array)
   ipt = loc (target)
-  array = 0    ! { dg-error "Vector assignment" }
+  array = 0    ! { dg-error "upper bound in the last dimension" }
 end subroutine err3
 
 subroutine err4