re PR fortran/38917 (Can't use DATA to initialize pointer to array to NULL())

2009-03-31  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/38917
	* expr.c (gfc_check_assign): Allow pointer components when
	checking for NULL.

	PR fortran/38918
	* resolve.c (check_data_variable): Treat pointer arrays with
	scalars.

2009-03-31  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/38917
	PR fortran/38918
	* gfortran.dg/data_pointer_1.f90: New test.

From-SVN: r145371

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index ef6d2b535fd190b9a8b215840df381f4e9c91ee5..0b9bc88fe20eacaec324d7c8d25b0d43e0f718a1 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -137,6 +137,16 @@
        Add 2009 to copyright years.
        * trans.c (gfc_trans_code): Likewise on both counts.
 
+2009-03-31  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/38917
+       * expr.c (gfc_check_assign): Allow pointer components when
+       checking for NULL.
+
+       PR fortran/38918
+       * resolve.c (check_data_variable): Treat pointer arrays with
+       scalars.
+
 2009-03-31  Paul Thomas  <pault@gcc.gnu.org>
 
        PR fortran/38915

diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 8dec53f3244c2d2e1d4e116d5ae979f932c6e77e..233516ec51c15568f750dff6fc6056709e1b5643 100644 (file)
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -2913,7 +2913,7 @@ gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue, int conform)
 
   if (rvalue->expr_type == EXPR_NULL)
     {  
-      if (lvalue->symtree->n.sym->attr.pointer
+      if (has_pointer && (ref == NULL || ref->next == NULL)
          && lvalue->symtree->n.sym->attr.data)
         return SUCCESS;
       else

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 4ab9df63a2a3706a029a7d84a637ac3764fd76aa..1fa1a79e23aa1418669e361852f548723035c111 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -9647,6 +9647,8 @@ check_data_variable (gfc_data_variable *var, locus *where)
   mpz_t section_index[GFC_MAX_DIMENSIONS];
   gfc_ref *ref;
   gfc_array_ref *ar;
+  gfc_symbol *sym;
+  int has_pointer;
 
   if (gfc_resolve_expr (var->expr) == FAILURE)
     return FAILURE;
@@ -9658,21 +9660,39 @@ check_data_variable (gfc_data_variable *var, locus *where)
   if (e->expr_type != EXPR_VARIABLE)
     gfc_internal_error ("check_data_variable(): Bad expression");
 
-  if (e->symtree->n.sym->ns->is_block_data
-      && !e->symtree->n.sym->attr.in_common)
+  sym = e->symtree->n.sym;
+
+  if (sym->ns->is_block_data && !sym->attr.in_common)
     {
       gfc_error ("BLOCK DATA element '%s' at %L must be in COMMON",
-                e->symtree->n.sym->name, &e->symtree->n.sym->declared_at);
+                sym->name, &sym->declared_at);
     }
 
-  if (e->ref == NULL && e->symtree->n.sym->as)
+  if (e->ref == NULL && sym->as)
     {
       gfc_error ("DATA array '%s' at %L must be specified in a previous"
-                " declaration", e->symtree->n.sym->name, where);
+                " declaration", sym->name, where);
       return FAILURE;
     }
 
-  if (e->rank == 0)
+  has_pointer = sym->attr.pointer;
+
+  for (ref = e->ref; ref; ref = ref->next)
+    {
+      if (ref->type == REF_COMPONENT && ref->u.c.component->attr.pointer)
+       has_pointer = 1;
+
+      if (has_pointer
+           && ref->type == REF_ARRAY
+           && ref->u.ar.type != AR_FULL)
+         {
+           gfc_error ("DATA element '%s' at %L is a pointer and so must "
+                       "be a full array", sym->name, where);
+           return FAILURE;
+         }
+    }
+
+  if (e->rank == 0 || has_pointer)
     {
       mpz_init_set_ui (size, 1);
       ref = NULL;

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index e2f3a2a88a7c7e9baaea021c8dcc46ea53f3dfe8..132d026f2dfb5d85b125f0b1de4dad256e64bb82 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2009-03-31  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/38917
+       PR fortran/38918
+       * gfortran.dg/data_pointer_1.f90: New test.
+
 2009-03-31  Paul Thomas  <pault@gcc.gnu.org>
 
        PR fortran/38915

diff --git a/gcc/testsuite/gfortran.dg/data_pointer_1.f90 b/gcc/testsuite/gfortran.dg/data_pointer_1.f90
new file mode 100644 (file)
index 0000000..8f08147
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/data_pointer_1.f90
@@ -0,0 +1,35 @@
+! { dg-do compile }
+! Test the fixes for PR38917 and 38918, in which the NULL values caused errors.
+!
+! Contributed by Dick Hendrickson  <dick.hendrickson@gmail.com>
+!             and Tobias Burnus  <burnus@gcc.gnu.org>
+!
+      SUBROUTINE PF0009
+!  PR38918
+      TYPE  :: HAS_POINTER
+        INTEGER, POINTER            :: PTR_S
+      END TYPE HAS_POINTER
+      TYPE (HAS_POINTER)  ::  PTR_ARRAY(5)
+
+      DATA PTR_ARRAY(1)%PTR_S  /NULL()/
+
+      end subroutine pf0009
+
+      SUBROUTINE PF0005
+! PR38917
+      REAL, SAVE, POINTER :: PTR1
+      INTEGER, POINTER       :: PTR2(:,:,:)
+      CHARACTER(LEN=1), SAVE, POINTER :: PTR3(:)
+
+      DATA  PTR1 / NULL() /
+      DATA  PTR2 / NULL() /
+      DATA  PTR3 / NULL() /
+
+      end subroutine pf0005
+
+! Tobias pointed out that this would cause an ICE rather than an error.
+      subroutine tobias
+      integer, pointer :: ptr(:)
+      data ptr(1) /NULL()/  ! { dg-error "must be a full array" }
+      end subroutine tobias
+