From 20ce6adefb26f000e84b92cc3206e0ac85011a24 Mon Sep 17 00:00:00 2001 From: "Steven G. Kargl" Date: Mon, 4 Jun 2018 15:54:48 +0000 Subject: [PATCH] re PR fortran/85981 (ICE in gfc_trans_string_copy, at fortran/trans-expr.c:6539) 2018-06-04 Steven G. Kargl PR fortran/85981 * resolve.c (resolve_allocate_deallocate): Check errmsg is default character kind. 2018-06-04 Steven G. Kargl PR fortran/85981 * gfortran.dg/allocate_alloc_opt_14.f90: New test. * gfortran.dg/allocate_alloc_opt_1.f90: Update error string. * gfortran.dg/allocate_stat_2.f90: Ditto. * gfortran.dg/deallocate_alloc_opt_1.f90: Ditto. From-SVN: r261154 --- gcc/fortran/ChangeLog | 6 ++++++ gcc/fortran/resolve.c | 9 +++++++-- gcc/testsuite/ChangeLog | 8 ++++++++ gcc/testsuite/gfortran.dg/allocate_alloc_opt_1.f90 | 2 +- gcc/testsuite/gfortran.dg/allocate_alloc_opt_14.f90 | 8 ++++++++ gcc/testsuite/gfortran.dg/allocate_stat_2.f90 | 2 +- gcc/testsuite/gfortran.dg/deallocate_alloc_opt_1.f90 | 2 +- 7 files changed, 32 insertions(+), 5 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/allocate_alloc_opt_14.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index ef7e941fd66..079a306c451 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2018-06-04 Steven G. Kargl + + PR fortran/85981 + * resolve.c (resolve_allocate_deallocate): Check errmsg is default + character kind. + 2018-06-03 Paul Thomas PR fortran/36497 diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 3a0ff80ab89..3d53ce56699 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -7767,12 +7767,17 @@ resolve_allocate_deallocate (gfc_code *code, const char *fcn) gfc_check_vardef_context (errmsg, false, false, false, _("ERRMSG variable")); + /* F18:R928 alloc-opt is ERRMSG = errmsg-variable + F18:R930 errmsg-variable is scalar-default-char-variable + F18:R906 default-char-variable is variable + F18:C906 default-char-variable shall be default character. */ if ((errmsg->ts.type != BT_CHARACTER && !(errmsg->ref && (errmsg->ref->type == REF_ARRAY || errmsg->ref->type == REF_COMPONENT))) - || errmsg->rank > 0 ) - gfc_error ("Errmsg-variable at %L must be a scalar CHARACTER " + || errmsg->rank > 0 + || errmsg->ts.kind != gfc_default_character_kind) + gfc_error ("ERRMSG variable at %L shall be a scalar default CHARACTER " "variable", &errmsg->where); for (p = code->ext.alloc.list; p; p = p->next) diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 459958eb5ea..e27cf415b70 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,11 @@ +2018-06-04 Steven G. Kargl + + PR fortran/85981 + * gfortran.dg/allocate_alloc_opt_14.f90: New test. + * gfortran.dg/allocate_alloc_opt_1.f90: Update error string. + * gfortran.dg/allocate_stat_2.f90: Ditto. + * gfortran.dg/deallocate_alloc_opt_1.f90: Ditto. + 2018-06-04 Richard Sandiford * gcc.target/aarch64/sve/extract_5.c: New test. diff --git a/gcc/testsuite/gfortran.dg/allocate_alloc_opt_1.f90 b/gcc/testsuite/gfortran.dg/allocate_alloc_opt_1.f90 index 95571fdfe12..12005a6cc16 100644 --- a/gcc/testsuite/gfortran.dg/allocate_alloc_opt_1.f90 +++ b/gcc/testsuite/gfortran.dg/allocate_alloc_opt_1.f90 @@ -22,7 +22,7 @@ program a allocate(i(2))) ! { dg-error "Syntax error in ALLOCATE" } allocate(i(2), errmsg=err, errmsg=err) ! { dg-error "Redundant ERRMSG" } allocate(i(2), errmsg=err) ! { dg-warning "useless without a STAT" } - allocate(i(2), stat=j, errmsg=x) ! { dg-error "must be a scalar CHARACTER" } + allocate(i(2), stat=j, errmsg=x) ! { dg-error "shall be a scalar default CHARACTER" } allocate(err) ! { dg-error "neither a data pointer nor an allocatable" } diff --git a/gcc/testsuite/gfortran.dg/allocate_alloc_opt_14.f90 b/gcc/testsuite/gfortran.dg/allocate_alloc_opt_14.f90 new file mode 100644 index 00000000000..6de43a7597f --- /dev/null +++ b/gcc/testsuite/gfortran.dg/allocate_alloc_opt_14.f90 @@ -0,0 +1,8 @@ +! { dg-do compile } +program p + integer, allocatable :: arr(:) + integer :: stat + character(len=128, kind=4) :: errmsg = ' ' + allocate (arr(3), stat=stat, errmsg=errmsg) ! { dg-error "shall be a scalar default CHARACTER" } + print *, allocated(arr), stat, trim(errmsg) +end diff --git a/gcc/testsuite/gfortran.dg/allocate_stat_2.f90 b/gcc/testsuite/gfortran.dg/allocate_stat_2.f90 index 7cf6d659ea2..a28a2536046 100644 --- a/gcc/testsuite/gfortran.dg/allocate_stat_2.f90 +++ b/gcc/testsuite/gfortran.dg/allocate_stat_2.f90 @@ -5,6 +5,6 @@ program main character(len=30), dimension(2) :: er integer, dimension (:), allocatable :: a allocate (a (16), stat = ier) ! { dg-error "must be a scalar INTEGER" } - allocate (a (14), stat=ier(1),errmsg=er) ! { dg-error "must be a scalar CHARACTER" } + allocate (a (14), stat=ier(1),errmsg=er) ! { dg-error "shall be a scalar default CHARACTER" } end diff --git a/gcc/testsuite/gfortran.dg/deallocate_alloc_opt_1.f90 b/gcc/testsuite/gfortran.dg/deallocate_alloc_opt_1.f90 index 969ce257efe..58790ebfb58 100644 --- a/gcc/testsuite/gfortran.dg/deallocate_alloc_opt_1.f90 +++ b/gcc/testsuite/gfortran.dg/deallocate_alloc_opt_1.f90 @@ -22,7 +22,7 @@ program a deallocate(i)) ! { dg-error "Syntax error in DEALLOCATE" } deallocate(i, errmsg=err, errmsg=err) ! { dg-error "Redundant ERRMSG" } deallocate(i, errmsg=err) ! { dg-warning "useless without a STAT" } - deallocate(i, stat=j, errmsg=x) ! { dg-error "must be a scalar CHARACTER" } + deallocate(i, stat=j, errmsg=x) ! { dg-error "shall be a scalar default CHARACTER" } deallocate(err) ! { dg-error "nonprocedure pointer nor an allocatable" } -- 2.30.2