From: Steven G. Kargl Date: Thu, 8 Dec 2016 21:26:11 +0000 (+0000) Subject: re PR fortran/65173 (ICE while compiling wrong code) X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=d0803c0cf815ee85711cd36f5d429f784ec6ac26;p=gcc.git re PR fortran/65173 (ICE while compiling wrong code) 2016-12-07 Steven G. Kargl 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 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 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 14bf4f9619e..eb5e987128c 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,16 @@ +2016-12-08 Steven G. Kargl + + 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 PR fortran/78659 diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 370b2a0e89c..fcd3a3fabc3 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -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; diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index ec1d0d692bf..b72863a2e58 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -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; diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index 0b711ca20b4..882be92efaf 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -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; } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index f00fcc2df38..7fe0e96a05c 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,26 @@ +2016-12-08 Steven G. Kargl + + 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 PR rtl-optimization/78671 diff --git a/gcc/testsuite/gfortran.dg/charlen_01.f90 b/gcc/testsuite/gfortran.dg/charlen_01.f90 new file mode 100644 index 00000000000..1a980fd1bd1 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/charlen_01.f90 @@ -0,0 +1,17 @@ +! { 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 diff --git a/gcc/testsuite/gfortran.dg/charlen_02.f90 b/gcc/testsuite/gfortran.dg/charlen_02.f90 new file mode 100644 index 00000000000..26405038462 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/charlen_02.f90 @@ -0,0 +1,7 @@ +! { 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 diff --git a/gcc/testsuite/gfortran.dg/charlen_03.f90 b/gcc/testsuite/gfortran.dg/charlen_03.f90 new file mode 100644 index 00000000000..37f4bd88998 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/charlen_03.f90 @@ -0,0 +1,9 @@ +! { 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" } + diff --git a/gcc/testsuite/gfortran.dg/charlen_04.f90 b/gcc/testsuite/gfortran.dg/charlen_04.f90 new file mode 100644 index 00000000000..f93465f2ae6 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/charlen_04.f90 @@ -0,0 +1,8 @@ +! { 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" } diff --git a/gcc/testsuite/gfortran.dg/charlen_05.f90 b/gcc/testsuite/gfortran.dg/charlen_05.f90 new file mode 100644 index 00000000000..0eb0015bf38 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/charlen_05.f90 @@ -0,0 +1,8 @@ +! { 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" } diff --git a/gcc/testsuite/gfortran.dg/charlen_06.f90 b/gcc/testsuite/gfortran.dg/charlen_06.f90 new file mode 100644 index 00000000000..e20d6047f68 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/charlen_06.f90 @@ -0,0 +1,8 @@ +! { 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" } diff --git a/gcc/testsuite/gfortran.dg/charlen_07.f90 b/gcc/testsuite/gfortran.dg/charlen_07.f90 new file mode 100644 index 00000000000..b1f5627a2fb --- /dev/null +++ b/gcc/testsuite/gfortran.dg/charlen_07.f90 @@ -0,0 +1,9 @@ +! { 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 diff --git a/gcc/testsuite/gfortran.dg/charlen_08.f90 b/gcc/testsuite/gfortran.dg/charlen_08.f90 new file mode 100644 index 00000000000..bab23b01b34 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/charlen_08.f90 @@ -0,0 +1,9 @@ +! { 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 diff --git a/gcc/testsuite/gfortran.dg/charlen_09.f90 b/gcc/testsuite/gfortran.dg/charlen_09.f90 new file mode 100644 index 00000000000..99b022bdfc4 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/charlen_09.f90 @@ -0,0 +1,9 @@ +! { 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 diff --git a/gcc/testsuite/gfortran.dg/charlen_10.f90 b/gcc/testsuite/gfortran.dg/charlen_10.f90 new file mode 100644 index 00000000000..2d7ba6cf0f7 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/charlen_10.f90 @@ -0,0 +1,9 @@ +! { 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" } + diff --git a/gcc/testsuite/gfortran.dg/charlen_11.f90 b/gcc/testsuite/gfortran.dg/charlen_11.f90 new file mode 100644 index 00000000000..d0635f97bb4 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/charlen_11.f90 @@ -0,0 +1,7 @@ +! { dg-do compile } +! PR fortran/65173 +program p + type t + character, allocatable :: z1(:), z1(:) ! { dg-error "already declared at" } + end type +end diff --git a/gcc/testsuite/gfortran.dg/charlen_12.f90 b/gcc/testsuite/gfortran.dg/charlen_12.f90 new file mode 100644 index 00000000000..cbf68d8d62f --- /dev/null +++ b/gcc/testsuite/gfortran.dg/charlen_12.f90 @@ -0,0 +1,8 @@ +! { 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 diff --git a/gcc/testsuite/gfortran.dg/charlen_13.f90 b/gcc/testsuite/gfortran.dg/charlen_13.f90 new file mode 100644 index 00000000000..d89b71c9dcb --- /dev/null +++ b/gcc/testsuite/gfortran.dg/charlen_13.f90 @@ -0,0 +1,10 @@ +! { 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" } diff --git a/gcc/testsuite/gfortran.dg/charlen_14.f90 b/gcc/testsuite/gfortran.dg/charlen_14.f90 new file mode 100644 index 00000000000..a9607853891 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/charlen_14.f90 @@ -0,0 +1,6 @@ +! { 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 diff --git a/gcc/testsuite/gfortran.dg/charlen_15.f90 b/gcc/testsuite/gfortran.dg/charlen_15.f90 new file mode 100644 index 00000000000..e141f1eb3ac --- /dev/null +++ b/gcc/testsuite/gfortran.dg/charlen_15.f90 @@ -0,0 +1,14 @@ +! { 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" } } + diff --git a/gcc/testsuite/gfortran.dg/charlen_16.f90 b/gcc/testsuite/gfortran.dg/charlen_16.f90 new file mode 100644 index 00000000000..826f733c82d --- /dev/null +++ b/gcc/testsuite/gfortran.dg/charlen_16.f90 @@ -0,0 +1,9 @@ +! { 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 diff --git a/gcc/testsuite/gfortran.dg/misplaced_implicit_character.f90 b/gcc/testsuite/gfortran.dg/misplaced_implicit_character.f90 index 8471d419eb0..fc79b80d0f4 100644 --- a/gcc/testsuite/gfortran.dg/misplaced_implicit_character.f90 +++ b/gcc/testsuite/gfortran.dg/misplaced_implicit_character.f90 @@ -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