mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-02-25 16:16:05 +08:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source 
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
This commit is contained in:
Paul Thomas 2009-03-31 20:05:44 +00:00
parent bf0d171aea
commit e49be8f7c3
5 changed files with 78 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
gcc/fortran/ChangeLog
View File

@ -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

2
gcc/fortran/expr.c
View File

@ -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

32
gcc/fortran/resolve.c
View File

@ -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;

6
gcc/testsuite/ChangeLog
View File

@ -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

35
gcc/testsuite/gfortran.dg/data_pointer_1.f90 Normal file
View File

@ -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