OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR fortran/29699 (ICE in trans-decl.c)

Browse Source 
2006-11-09 Paul Thomas <pault@gcc.gnu.org>

	PR fortran/29699
	* trans-array.c (structure_alloc_comps): Detect pointers to
	arrays and use indirect reference to declaration.
	* resolve.c (resolve_fl_variable): Tidy up condition.
	(resolve_symbol): The same and only add initialization code if
	the symbol is referenced.
	* trans-decl.c (gfc_trans_deferred_vars): Call gfc_trans_
	deferred_array before gfc_trans_auto_array_allocation.

	PR fortran/21730
	* symbol.c (check_done): Remove.
	(gfc_add_attribute): Remove reference to check_done and remove
	the argument attr_intent.
	(gfc_add_allocatable, gfc_add_dimension, gfc_add_external,
	gfc_add_intrinsic, gfc_add_optional, gfc_add_pointer,
	gfc_add_cray_pointer, gfc_add_cray_pointee, gfc_add_result,
	gfc_add_target, gfc_add_in_common, gfc_add_elemental,
	gfc_add_pure, gfc_add_recursive, gfc_add_procedure,
	gfc_add_type): Remove references to check_done.
	* decl.c (attr_decl1): Eliminate third argument in call to
	gfc_add_attribute.
	* gfortran.h : Change prototype for gfc_add_attribute.



2006-11-09 Paul Thomas <pault@gcc.gnu.org>

	PR fortran/29699
	* gfortran.dg/alloc_comp_auto_array_1.f90: New test.

	PR fortran/21730
	* gfortran.dg/change_symbol_attributes_1.f90: New test.

From-SVN: r118624
This commit is contained in:
Paul Thomas 2006-11-09 18:42:28 +00:00
parent d82a02fa4f
commit 7114edca02
10 changed files with 139 additions and 56 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
gcc/fortran/ChangeLog
View File

@ -1,3 +1,28 @@
2006-11-09 Paul Thomas <pault@gcc.gnu.org>
PR fortran/29699
* trans-array.c (structure_alloc_comps): Detect pointers to
arrays and use indirect reference to declaration.
* resolve.c (resolve_fl_variable): Tidy up condition.
(resolve_symbol): The same and only add initialization code if
the symbol is referenced.
* trans-decl.c (gfc_trans_deferred_vars): Call gfc_trans_
deferred_array before gfc_trans_auto_array_allocation.
PR fortran/21730
* symbol.c (check_done): Remove.
(gfc_add_attribute): Remove reference to check_done and remove
the argument attr_intent.
(gfc_add_allocatable, gfc_add_dimension, gfc_add_external,
gfc_add_intrinsic, gfc_add_optional, gfc_add_pointer,
gfc_add_cray_pointer, gfc_add_cray_pointee, gfc_add_result,
gfc_add_target, gfc_add_in_common, gfc_add_elemental,
gfc_add_pure, gfc_add_recursive, gfc_add_procedure,
gfc_add_type): Remove references to check_done.
* decl.c (attr_decl1): Eliminate third argument in call to
gfc_add_attribute.
* gfortran.h : Change prototype for gfc_add_attribute.
2006-11-08 Brooks Moses <brooks.moses@codesourcery.com>
* invoke.texi: Added documentation for -fmax-errors option.

2
gcc/fortran/decl.c
View File

@ -3330,7 +3330,7 @@ attr_decl1 (void)
goto cleanup;
}
if (gfc_add_attribute (&sym->attr, &var_locus, current_attr.intent) == FAILURE)
if (gfc_add_attribute (&sym->attr, &var_locus) == FAILURE)
{
m = MATCH_ERROR;
goto cleanup;

2
gcc/fortran/gfortran.h
View File

@ -1838,7 +1838,7 @@ void gfc_get_component_attr (symbol_attribute *, gfc_component *);
void gfc_set_sym_referenced (gfc_symbol * sym);
try gfc_add_attribute (symbol_attribute *, locus *, unsigned int);
try gfc_add_attribute (symbol_attribute *, locus *);
try gfc_add_allocatable (symbol_attribute *, locus *);
try gfc_add_dimension (symbol_attribute *, const char *, locus *);
try gfc_add_external (symbol_attribute *, locus *);

15
gcc/fortran/resolve.c
View File

@ -5497,8 +5497,11 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag)
}
/* Assign default initializer. */
if (sym->ts.type == BT_DERIVED && !sym->value && !sym->attr.pointer
&& !sym->attr.allocatable && (!flag || sym->attr.intent == INTENT_OUT))
if (sym->ts.type == BT_DERIVED
&& !sym->value
&& !sym->attr.pointer
&& !sym->attr.allocatable
&& (!flag || sym->attr.intent == INTENT_OUT))
sym->value = gfc_default_initializer (&sym->ts);
return SUCCESS;
@ -6036,8 +6039,12 @@ resolve_symbol (gfc_symbol * sym)
/* If we have come this far we can apply default-initializers, as
described in 14.7.5, to those variables that have not already
been assigned one. */
if (sym->ts.type == BT_DERIVED && sym->ns == gfc_current_ns && !sym->value
&& !sym->attr.allocatable && !sym->attr.alloc_comp)
if (sym->ts.type == BT_DERIVED
&& sym->attr.referenced
&& sym->ns == gfc_current_ns
&& !sym->value
&& !sym->attr.allocatable
&& !sym->attr.alloc_comp)
{
symbol_attribute *a = &sym->attr;

63
gcc/fortran/symbol.c
View File

@ -601,28 +601,6 @@ check_used (symbol_attribute * attr, const char * name, locus * where)
}
/* Used to prevent changing the attributes of a symbol after it has been
used. This check is only done for dummy variables as only these can be
used in specification expressions. Applying this to all symbols causes
an error when we reach the body of a contained function. */
static int
check_done (symbol_attribute * attr, locus * where)
{
if (!(attr->dummy && attr->referenced))
return 0;
if (where == NULL)
where = &gfc_current_locus;
gfc_error ("Cannot change attributes of symbol at %L"
" after it has been used", where);
return 1;
}
/* Generate an error because of a duplicate attribute. */
static void
@ -638,12 +616,9 @@ duplicate_attr (const char *attr, locus * where)
/* Called from decl.c (attr_decl1) to check attributes, when declared separately. */
try
gfc_add_attribute (symbol_attribute * attr, locus * where,
unsigned int attr_intent)
gfc_add_attribute (symbol_attribute * attr, locus * where)
{
if (check_used (attr, NULL, where)
|| (attr_intent == 0 && check_done (attr, where)))
if (check_used (attr, NULL, where))
return FAILURE;
return check_conflict (attr, NULL, where);
@ -653,7 +628,7 @@ try
gfc_add_allocatable (symbol_attribute * attr, locus * where)
{
if (check_used (attr, NULL, where) || check_done (attr, where))
if (check_used (attr, NULL, where))
return FAILURE;
if (attr->allocatable)
@ -671,7 +646,7 @@ try
gfc_add_dimension (symbol_attribute * attr, const char *name, locus * where)
{
if (check_used (attr, name, where) || check_done (attr, where))
if (check_used (attr, name, where))
return FAILURE;
if (attr->dimension)
@ -689,7 +664,7 @@ try
gfc_add_external (symbol_attribute * attr, locus * where)
{
if (check_used (attr, NULL, where) || check_done (attr, where))
if (check_used (attr, NULL, where))
return FAILURE;
if (attr->external)
@ -708,7 +683,7 @@ try
gfc_add_intrinsic (symbol_attribute * attr, locus * where)
{
if (check_used (attr, NULL, where) || check_done (attr, where))
if (check_used (attr, NULL, where))
return FAILURE;
if (attr->intrinsic)
@ -727,7 +702,7 @@ try
gfc_add_optional (symbol_attribute * attr, locus * where)
{
if (check_used (attr, NULL, where) || check_done (attr, where))
if (check_used (attr, NULL, where))
return FAILURE;
if (attr->optional)
@ -745,7 +720,7 @@ try
gfc_add_pointer (symbol_attribute * attr, locus * where)
{
if (check_used (attr, NULL, where) || check_done (attr, where))
if (check_used (attr, NULL, where))
return FAILURE;
attr->pointer = 1;
@ -757,7 +732,7 @@ try
gfc_add_cray_pointer (symbol_attribute * attr, locus * where)
{
if (check_used (attr, NULL, where) || check_done (attr, where))
if (check_used (attr, NULL, where))
return FAILURE;
attr->cray_pointer = 1;
@ -769,7 +744,7 @@ try
gfc_add_cray_pointee (symbol_attribute * attr, locus * where)
{
if (check_used (attr, NULL, where) || check_done (attr, where))
if (check_used (attr, NULL, where))
return FAILURE;
if (attr->cray_pointee)
@ -788,7 +763,7 @@ try
gfc_add_result (symbol_attribute * attr, const char *name, locus * where)
{
if (check_used (attr, name, where) || check_done (attr, where))
if (check_used (attr, name, where))
return FAILURE;
attr->result = 1;
@ -866,7 +841,7 @@ try
gfc_add_target (symbol_attribute * attr, locus * where)
{
if (check_used (attr, NULL, where) || check_done (attr, where))
if (check_used (attr, NULL, where))
return FAILURE;
if (attr->target)
@ -897,7 +872,7 @@ try
gfc_add_in_common (symbol_attribute * attr, const char *name, locus * where)
{
if (check_used (attr, name, where) || check_done (attr, where))
if (check_used (attr, name, where))
return FAILURE;
/* Duplicate attribute already checked for. */
@ -965,7 +940,7 @@ try
gfc_add_elemental (symbol_attribute * attr, locus * where)
{
if (check_used (attr, NULL, where) || check_done (attr, where))
if (check_used (attr, NULL, where))
return FAILURE;
attr->elemental = 1;
@ -977,7 +952,7 @@ try
gfc_add_pure (symbol_attribute * attr, locus * where)
{
if (check_used (attr, NULL, where) || check_done (attr, where))
if (check_used (attr, NULL, where))
return FAILURE;
attr->pure = 1;
@ -989,7 +964,7 @@ try
gfc_add_recursive (symbol_attribute * attr, locus * where)
{
if (check_used (attr, NULL, where) || check_done (attr, where))
if (check_used (attr, NULL, where))
return FAILURE;
attr->recursive = 1;
@ -1093,7 +1068,7 @@ gfc_add_procedure (symbol_attribute * attr, procedure_type t,
const char *name, locus * where)
{
if (check_used (attr, name, where) || check_done (attr, where))
if (check_used (attr, name, where))
return FAILURE;
if (attr->flavor != FL_PROCEDURE
@ -1202,10 +1177,6 @@ gfc_add_type (gfc_symbol * sym, gfc_typespec * ts, locus * where)
{
sym_flavor flavor;
/* TODO: This is legal if it is reaffirming an implicit type.
if (check_done (&sym->attr, where))
return FAILURE;*/
if (where == NULL)
where = &gfc_current_locus;

3
gcc/fortran/trans-array.c
View File

@ -4744,6 +4744,9 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
gfc_init_block (&fnblock);
if (POINTER_TYPE_P (TREE_TYPE (decl)))
decl = build_fold_indirect_ref (decl);
/* If this an array of derived types with allocatable components
build a loop and recursively call this function. */
if (TREE_CODE (TREE_TYPE (decl)) == ARRAY_TYPE

18
gcc/fortran/trans-decl.c
View File

@ -2591,6 +2591,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody)
gfc_symbol *sym;
gfc_formal_arglist *f;
stmtblock_t body;
bool seen_trans_deferred_array = false;
/* Deal with implicit return variables. Explicit return variables will
already have been added. */
@ -2647,10 +2648,19 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody)
if (TREE_STATIC (sym->backend_decl))
gfc_trans_static_array_pointer (sym);
else
fnbody = gfc_trans_deferred_array (sym, fnbody);
{
seen_trans_deferred_array = true;
fnbody = gfc_trans_deferred_array (sym, fnbody);
}
}
else
{
if (sym_has_alloc_comp)
{
seen_trans_deferred_array = true;
fnbody = gfc_trans_deferred_array (sym, fnbody);
}
gfc_get_backend_locus (&loc);
gfc_set_backend_locus (&sym->declared_at);
fnbody = gfc_trans_auto_array_allocation (sym->backend_decl,
@ -2676,14 +2686,14 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody)
break;
case AS_DEFERRED:
if (!sym_has_alloc_comp)
fnbody = gfc_trans_deferred_array (sym, fnbody);
seen_trans_deferred_array = true;
fnbody = gfc_trans_deferred_array (sym, fnbody);
break;
default:
gcc_unreachable ();
}
if (sym_has_alloc_comp)
if (sym_has_alloc_comp && !seen_trans_deferred_array)
fnbody = gfc_trans_deferred_array (sym, fnbody);
}
else if (sym_has_alloc_comp)

8
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,11 @@
2006-11-09 Paul Thomas <pault@gcc.gnu.org>
PR fortran/29699
* gfortran.dg/alloc_comp_auto_array_1.f90: New test.
PR fortran/21730
* gfortran.dg/change_symbol_attributes_1.f90: New test.
2006-11-09 Andreas Krebbel <krebbel1@de.ibm.com>
* gcc.dg/20061109-1.c: New testcase.

42
gcc/testsuite/gfortran.dg/alloc_comp_auto_array_1.f90 Normal file
View File

@ -0,0 +1,42 @@
! { dg-do run }
! Fix for PR29699 - see below for details.
!
! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
!
PROGRAM vocabulary_word_count
IMPLICIT NONE
TYPE VARYING_STRING
CHARACTER,DIMENSION(:),ALLOCATABLE :: chars
ENDTYPE VARYING_STRING
INTEGER :: list_size=200
call extend_lists2
CONTAINS
! First the original problem: vocab_swap not being referenced caused
! an ICE because default initialization is used, which results in a
! call to gfc_conv_variable, which calls gfc_get_symbol_decl.
SUBROUTINE extend_lists1
type(VARYING_STRING),DIMENSION(list_size) :: vocab_swap
ENDSUBROUTINE extend_lists1
! Curing this then uncovered two more problems: If vocab_swap were
! actually referenced, an ICE occurred in the gimplifier because
! the declaration for this automatic array is presented as a
! pointer to the array, rather than the array. Curing this allows
! the code to compile but it bombed out at run time because the
! malloc/free occurred in the wrong order with respect to the
! nullify/deallocate of the allocatable components.
SUBROUTINE extend_lists2
type(VARYING_STRING),DIMENSION(list_size) :: vocab_swap
allocate (vocab_swap(1)%chars(10))
if (.not.allocated(vocab_swap(1)%chars)) call abort ()
if (allocated(vocab_swap(10)%chars)) call abort ()
ENDSUBROUTINE extend_lists2
ENDPROGRAM vocabulary_word_count

17
gcc/testsuite/gfortran.dg/change_symbol_attributes_1.f90 Normal file
View File

@ -0,0 +1,17 @@
! { dg-do compile }
! Fix for PR21730 - declarations used to produce the error:
! target :: x ! these 2 lines interchanged
! 1
! Error: Cannot change attributes of symbol at (1) after it has been used.
!
! Contributed by Harald Anlauf <anlauf@gmx.de>
!
subroutine gfcbug27 (x)
real, intent(inout) :: x(:)
real :: tmp(size (x,1)) ! gfc produces an error unless
target :: x ! these 2 lines interchanged
real, pointer :: p(:)
p => x(:)
end subroutine gfcbug27