All,
The attach patch fixes an ICE from a testcase in PR fortran/65173.
First, I draw your attention to the comment in gfortran.h above
the definition of gfc_charlen. It is
/* Character length structures hold the expression that gives the
length of a character variable. We avoid putting these into
gfc_typespec because doing so prevents us from doing structure
copies and forces us to deallocate any typespecs we create, as well
as structures that contain typespecs. They also can have multiple
character typespecs pointing to them.
These structures form a singly linked list within the current
namespace and are deallocated with the namespace. It is possible to
end up with gfc_charlen structures that have nothing pointing to them. */
The last paragraph is important, here. So, the problematic code was
program foo
type t
character, allocatable :: z1(:), z1(:)
end type t
end program foo
gfortran rightly rejected this code and issues an appropriate error.
However, when parse.c (reject_statement) tries to cleanup the parsing
of the invalid statement, it manages to corrupt the namespace's cl_list.
How? Well, that's a good question on which I wasted too much time given
the last paragraph in the gfortran.h comment. Removing the manipulations
of the cl_list in reject_statement, then revealed that old_cl_list is
unneeded. So, I give unto you
2016-12-07 Steven G. Kargl <ka...@gcc.gnu.org>
PR fortran/65173
* gfortran.h (gfc_namespace): Remove old_cl_list member.
* parse.c (use_modules, next_statement): old_cl_list is gone.
(clear_default_charlen): Remove no longer used function.
(reject_statement): Do not try to clean up gfc_charlen structure(s)
that may have been added to a cl_list list.
* symbol.c (gfc_new_charlen): old_cl_list structure is gone.
2016-12-07 Steven G. Kargl <ka...@gcc.gnu.org>
PR fortran/65173
* gfortran.dg/misplaced_implicit_character.f90: Adjust errors.
* gfortran.dg/pr65173.f90: New test.
The patch is attached and regression tested on x86_64-*-freebsd.
OK to commit?
--
Steve
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h (revision 243376)
+++ gcc/fortran/gfortran.h (working copy)
@@ -1768,7 +1768,7 @@ typedef struct gfc_namespace
/* !$ACC ROUTINE names. */
gfc_oacc_routine_name *oacc_routine_names;
- gfc_charlen *cl_list, *old_cl_list;
+ gfc_charlen *cl_list;
gfc_dt_list *derived_types;
Index: gcc/fortran/parse.c
===================================================================
--- gcc/fortran/parse.c (revision 243376)
+++ gcc/fortran/parse.c (working copy)
@@ -116,7 +116,6 @@ use_modules (void)
gfc_pop_error (&old_error);
gfc_commit_symbols ();
gfc_warning_check ();
- gfc_current_ns->old_cl_list = gfc_current_ns->cl_list;
gfc_current_ns->old_equiv = gfc_current_ns->equiv;
gfc_current_ns->old_data = gfc_current_ns->data;
last_was_use_stmt = false;
@@ -1386,7 +1385,6 @@ next_statement (void)
gfc_new_block = NULL;
- gfc_current_ns->old_cl_list = gfc_current_ns->cl_list;
gfc_current_ns->old_equiv = gfc_current_ns->equiv;
gfc_current_ns->old_data = gfc_current_ns->data;
for (;;)
@@ -2483,41 +2481,13 @@ accept_statement (gfc_statement st)
}
-/* Clear default character types with charlen pointers that are about
- to become invalid. */
-
-static void
-clear_default_charlen (gfc_namespace *ns, const gfc_charlen *cl,
- const gfc_charlen *end)
-{
- gfc_typespec *ts;
-
- for (ts = &ns->default_type[0]; ts < &ns->default_type[GFC_LETTERS]; ts++)
- if (ts->type == BT_CHARACTER)
- {
- const gfc_charlen *cl2;
- for (cl2 = cl; cl2 != end; cl2 = cl2->next)
- if (ts->u.cl == cl2)
- {
- ts->u.cl = NULL;
- ts->type = BT_UNKNOWN;
- break;
- }
- }
-}
-
-/* Undo anything tentative that has been built for the current
- statement. */
+/* Undo anything tentative that has been built for the current statement,
+ except if a gfc_charlen structure has been added to current namespace's
+ list of gfc_charlen structure. */
static void
reject_statement (void)
{
- /* Revert to the previous charlen chain. */
- clear_default_charlen (gfc_current_ns,
- gfc_current_ns->cl_list, gfc_current_ns->old_cl_list);
- gfc_free_charlen (gfc_current_ns->cl_list, gfc_current_ns->old_cl_list);
- gfc_current_ns->cl_list = gfc_current_ns->old_cl_list;
-
gfc_free_equiv_until (gfc_current_ns->equiv, gfc_current_ns->old_equiv);
gfc_current_ns->equiv = gfc_current_ns->old_equiv;
Index: gcc/fortran/symbol.c
===================================================================
--- gcc/fortran/symbol.c (revision 243376)
+++ gcc/fortran/symbol.c (working copy)
@@ -3794,31 +3794,22 @@ gfc_charlen*
gfc_new_charlen (gfc_namespace *ns, gfc_charlen *old_cl)
{
gfc_charlen *cl;
+
cl = gfc_get_charlen ();
/* Copy old_cl. */
if (old_cl)
{
- /* Put into namespace, but don't allow reject_statement
- to free it if old_cl is given. */
- gfc_charlen **prev = &ns->cl_list;
- cl->next = ns->old_cl_list;
- while (*prev != ns->old_cl_list)
- prev = &(*prev)->next;
- *prev = cl;
- ns->old_cl_list = cl;
cl->length = gfc_copy_expr (old_cl->length);
cl->length_from_typespec = old_cl->length_from_typespec;
cl->backend_decl = old_cl->backend_decl;
cl->passed_length = old_cl->passed_length;
cl->resolved = old_cl->resolved;
}
- else
- {
- /* Put into namespace. */
- cl->next = ns->cl_list;
- ns->cl_list = cl;
- }
+
+ /* Put into namespace. */
+ cl->next = ns->cl_list;
+ ns->cl_list = cl;
return cl;
}
Index: gcc/testsuite/gfortran.dg/misplaced_implicit_character.f90
===================================================================
--- gcc/testsuite/gfortran.dg/misplaced_implicit_character.f90 (revision 243376)
+++ gcc/testsuite/gfortran.dg/misplaced_implicit_character.f90 (working copy)
@@ -3,6 +3,6 @@
subroutine s
real x ! { dg-error "" }
implicit character (a) ! { dg-error "IMPLICIT statement at .1. cannot follow data declaration statement at .2." }
-
- a1 = 'z' ! { dg-error "Symbol .a1. at .1. has no IMPLICIT type" }
+ x = 1
+ a = 'a'
end subroutine s
Index: gcc/testsuite/gfortran.dg/pr65173.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr65173.f90 (nonexistent)
+++ gcc/testsuite/gfortran.dg/pr65173.f90 (working copy)
@@ -0,0 +1,7 @@
+! { dg-do compile }
+program p
+ type t
+ character, allocatable :: z1(:), z1(:) ! { dg-error "already declared" }
+ end type
+end
+
