Commit d0803c0c by Steven G. Kargl

re PR fortran/65173 (ICE while compiling wrong code)

2016-12-07  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/65173
	PR fortran/69064
	PR fortran/69859
	PR fortran/78350
	* 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 ot 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  <kargl@gcc.gnu.org>

	PR fortran/65173
	PR fortran/69064
	PR fortran/69859
	PR fortran/78350
	* gfortran.dg/misplaced_implicit_character.f90: Adjust errors.
	* gfortran.dg/charlen_01.f90: New test.
	* gfortran.dg/charlen_02.f90: Ditto.
	* gfortran.dg/charlen_03.f90: Ditto.
	* gfortran.dg/charlen_04.f90: Ditto.
	* gfortran.dg/charlen_05.f90: Ditto.
	* gfortran.dg/charlen_06.f90: Ditto.
	* gfortran.dg/charlen_07.f90: Ditto.
	* gfortran.dg/charlen_08.f90: Ditto.
	* gfortran.dg/charlen_09.f90: Ditto.
	* gfortran.dg/charlen_10.f90: Ditto.
	* gfortran.dg/charlen_11.f90: Ditto.
	* gfortran.dg/charlen_12.f90: Ditto.
	* gfortran.dg/charlen_13.f90: Ditto.
	* gfortran.dg/charlen_14.f90: Ditto.
	* gfortran.dg/charlen_15.f90: Ditto.
	* gfortran.dg/charlen_16.f90: Ditto.

From-SVN: r243463
parent 7e964f49
2016-12-08 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/65173
PR fortran/69064
PR fortran/69859
PR fortran/78350
* 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 ot 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-06 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR fortran/78659
......
......@@ -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;
......
......@@ -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;
......
......@@ -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;
}
......
2016-12-08 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/65173
PR fortran/69064
PR fortran/69859
PR fortran/78350
* gfortran.dg/misplaced_implicit_character.f90: Adjust errors.
* gfortran.dg/charlen_01.f90: New test.
* gfortran.dg/charlen_02.f90: Ditto.
* gfortran.dg/charlen_03.f90: Ditto.
* gfortran.dg/charlen_04.f90: Ditto.
* gfortran.dg/charlen_05.f90: Ditto.
* gfortran.dg/charlen_06.f90: Ditto.
* gfortran.dg/charlen_07.f90: Ditto.
* gfortran.dg/charlen_08.f90: Ditto.
* gfortran.dg/charlen_09.f90: Ditto.
* gfortran.dg/charlen_10.f90: Ditto.
* gfortran.dg/charlen_11.f90: Ditto.
* gfortran.dg/charlen_12.f90: Ditto.
* gfortran.dg/charlen_13.f90: Ditto.
* gfortran.dg/charlen_14.f90: Ditto.
* gfortran.dg/charlen_15.f90: Ditto.
2016-12-08 Vladimir Makarov <vmakarov@redhat.com>
PR rtl-optimization/78671
......
! { dg-do compile }
! PR fortran/65173
program min_obj
implicit none
integer, parameter :: a = 128
type :: param_t
integer :: n= 0
real*8, dimension(256), allocatable :: x ! { dg-error "must have a deferred shape" }
real*8, dimension(2,256), allocatable :: bounds ! { dg-error "must have a deferred shape" }
character(a), dimension(256), allocatable :: names ! { dg-error "must have a deferred shape" }
end type param_t
contains
subroutine extrace_params_from_section ( )
character(*), dimension(), parameter :: & ! { dg-error "expression in array specification" }
& char_params = ['element', 'parametrization']
end subroutine extrace_params_from_section
end program min_obj
! { dg-do compile }
! PR fortran/65173
program p
type t
character(1), allocatable :: n(256) ! { dg-error "must have a deferred shape" }
end type
end
! { dg-do compile }
! PR fortran/65173
program p
type t
character(:), allocatable :: x(n) ! { dg-error "must have a deferred shape" }
end type
end
! { dg-excess-errors "must be of INTEGER type" }
! { dg-do compile }
! PR fortran/65173
program p
type t
character(*), allocatable :: x(*) ! { dg-error "must have a deferred shape" }
end type
end
! { dg-excess-errors "needs to be a constant specification" }
! { dg-do compile }
! PR fortran/65173
program p
type t
character(*) :: x y ! { dg-error "error in data declaration" }
end type
end
! { dg-excess-errors "needs to be a constant specification" }
! { dg-do compile }
! PR fortran/65173
program p
type t
character(*) :: x+1 ! { dg-error "error in data declaration" }
end type
end
! { dg-excess-errors "needs to be a constant specification" }
! { dg-do compile }
! PR fortran/65173
program p
type t
end type
type, extends(t) :: t2
character x = ! { dg-error "error in data declaration" }
end type
end
! { dg-do compile }
! PR fortran/65173
program p
type t
end type
type, extends(t) :: t2
character x 'x' ! { dg-error "error in data declaration" }
end type
end
! { dg-do compile }
! PR fortran/65173
program p
type t
end type
type, extends(t) :: t2
character x(:) ! { dg-error "must have an explicit shape" }
end type
end
! { dg-do compile }
! PR fortran/65173
program p
type t
character(:), allocatable :: x(y)1 ! { dg-error "must have a deferred shape" }
end type
end
! { dg-excess-errors "must be of INTEGER type" }
! { dg-do compile }
! PR fortran/65173
program p
type t
character, allocatable :: z1(:), z1(:) ! { dg-error "already declared at" }
end type
end
! { dg-do compile }
! PR fortran/65173
program p
type t
character, allocatable :: z1(:) ! { dg-error "." }
character, allocatable :: z1(:) ! { dg-error "already declared at" }
end type
end
! { dg-do compile }
! PR fortran/69859
program p
type t
character(2), allocatable :: a(*) ! { dg-error "must have a deferred shape" }
character(*), allocatable :: b(2) ! { dg-error "must have a deferred shape" }
character(*), allocatable :: c(*) ! { dg-error "must have a deferred shape" }
end type
end
! { dg-excess-errors "needs to be a constant specification" }
! { dg-do compile }
! PR fortran/69064
subroutine setup_check_path(path) ! { dg-error "has no IMPLICIT type" }
implicit none
character(len=path_len),intent(inout)::path ! { dg-error "Scalar INTEGER expression" }
end
! { dg-do run }
! PR fortran/78350
module m
type t
character(2) :: c(1) = [character(3) :: 'abc']
end type
type(t) :: x
end
program foo
use m
if (trim(x%c(1)) /= 'ab') call abort
end program foo
! { dg-final { cleanup-modules "m" } }
! { dg-do run }
! PR fortran/78350
program p
type t
character(2) :: c(1) = [character(3) :: 'abc']
end type
type(t) :: x
if (trim(x%c(1)) /= 'ab') call abort
end
......@@ -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
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment