+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
/* !$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;
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;
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 (;;)
}
-/* 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;
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
--- /dev/null
+! { 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
--- /dev/null
+! { 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
--- /dev/null
+! { 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" }
+
--- /dev/null
+! { 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" }
--- /dev/null
+! { 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" }
--- /dev/null
+! { 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" }
--- /dev/null
+! { 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
--- /dev/null
+! { 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
--- /dev/null
+! { 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
--- /dev/null
+! { 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" }
+
--- /dev/null
+! { dg-do compile }
+! PR fortran/65173
+program p
+ type t
+ character, allocatable :: z1(:), z1(:) ! { dg-error "already declared at" }
+ end type
+end
--- /dev/null
+! { 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
--- /dev/null
+! { 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" }
--- /dev/null
+! { 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
--- /dev/null
+! { 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" } }
+
--- /dev/null
+! { 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
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
projects / gcc.git / commitdiff