From: Paul Thomas Date: Tue, 31 Mar 2009 20:05:44 +0000 (+0000) Subject: re PR fortran/38917 (Can't use DATA to initialize pointer to array to NULL()) X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=e49be8f7c371881733a0f9b0c7ecccef5232f10e;p=gcc.git re PR fortran/38917 (Can't use DATA to initialize pointer to array to NULL()) 2009-03-31 Paul Thomas 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 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 ef6d2b535fd..0b9bc88fe20 100644 --- 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 + + 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 PR fortran/38915 diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index 8dec53f3244..233516ec51c 100644 --- 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 4ab9df63a2a..1fa1a79e23a 100644 --- 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 e2f3a2a88a7..132d026f2df 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2009-03-31 Paul Thomas + + PR fortran/38917 + PR fortran/38918 + * gfortran.dg/data_pointer_1.f90: New test. + 2009-03-31 Paul Thomas 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 index 00000000000..8f081474ca4 --- /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 +! and Tobias Burnus +! + 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 +