From 06119d691e27e25fd4f4486467ad95f7b545fde3 Mon Sep 17 00:00:00 2001 From: Mark Eggleston Date: Tue, 18 Feb 2020 15:54:13 +0000 Subject: [PATCH] [fortran] ICE assign character pointer to non target PR93714 An ICE occurred if an attempt was made to assign a pointer to a character variable that has an length incorrectly specified using a real constant and does not have the target attribute. gcc/fortran/ChangeLog PR fortran/93714 * expr.c (gfc_check_pointer_assign): Move check for matching character length to after checking the lvalue attributes for target or pointer. gcc/testsuite/ChangeLog PR fortran/93714 * gfortran.dg/char_pointer_assign_6.f90: Look for no target message instead of length mismatch. * gfortran.dg/pr93714_1.f90 * gfortran.dg/pr93714_2.f90 --- gcc/fortran/ChangeLog | 7 +++++++ gcc/fortran/expr.c | 14 +++++++------- gcc/testsuite/ChangeLog | 8 ++++++++ .../gfortran.dg/char_pointer_assign_6.f90 | 4 ++-- gcc/testsuite/gfortran.dg/pr93714_1.f90 | 11 +++++++++++ gcc/testsuite/gfortran.dg/pr93714_2.f90 | 11 +++++++++++ 6 files changed, 46 insertions(+), 9 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/pr93714_1.f90 create mode 100644 gcc/testsuite/gfortran.dg/pr93714_2.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 5daaefdee9b..7547dccd79a 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2020-02-18 Mark Eggleston + + PR fortran/93714 + * expr.c (gfc_check_pointer_assign): Move check for + matching character length to after checking the lvalue + attributes for target or pointer. + 2020-02-18 Steven G. Kargl PR fortran/93601 diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index a9698c3e3d2..79e00b4112a 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -4222,13 +4222,6 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue, if (rvalue->expr_type == EXPR_NULL) return true; - if (lvalue->ts.type == BT_CHARACTER) - { - bool t = gfc_check_same_strlen (lvalue, rvalue, "pointer assignment"); - if (!t) - return false; - } - if (rvalue->expr_type == EXPR_VARIABLE && is_subref_array (rvalue)) lvalue->symtree->n.sym->attr.subref_array_pointer = 1; @@ -4284,6 +4277,13 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue, } } + if (lvalue->ts.type == BT_CHARACTER) + { + bool t = gfc_check_same_strlen (lvalue, rvalue, "pointer assignment"); + if (!t) + return false; + } + if (is_pure && gfc_impure_variable (rvalue->symtree->n.sym)) { gfc_error ("Bad target in pointer assignment in PURE " diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 6b008fde202..270644a97d2 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,11 @@ +2020-02-18 Mark Eggleston + + PR fortran/93714 + * gfortran.dg/char_pointer_assign_6.f90: Look for no target + message instead of length mismatch. + * gfortran.dg/pr93714_1.f90 + * gfortran.dg/pr93714_2.f90 + 2020-02-18 Mark Eggleston PR fortran/93601 diff --git a/gcc/testsuite/gfortran.dg/char_pointer_assign_6.f90 b/gcc/testsuite/gfortran.dg/char_pointer_assign_6.f90 index cd90bfc06e3..e0e116074ae 100644 --- a/gcc/testsuite/gfortran.dg/char_pointer_assign_6.f90 +++ b/gcc/testsuite/gfortran.dg/char_pointer_assign_6.f90 @@ -6,6 +6,6 @@ program main character (len=4) :: c s1 = 'abcd' p1 => s1(2:3) ! { dg-error "Unequal character lengths \\(20/2\\)" } - p1 => c(1:) ! { dg-error "Unequal character lengths \\(20/4\\)" } - p1 => c(:4) ! { dg-error "Unequal character lengths \\(20/4\\)" } + p1 => c(1:) ! { dg-error "Pointer assignment target" } + p1 => c(:4) ! { dg-error "Pointer assignment target" } end diff --git a/gcc/testsuite/gfortran.dg/pr93714_1.f90 b/gcc/testsuite/gfortran.dg/pr93714_1.f90 new file mode 100644 index 00000000000..40f4a4bf89f --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr93714_1.f90 @@ -0,0 +1,11 @@ +! { dg-do compile } +! PR 93714 +! Original test case from G. Steinmetz + +program test + character((1.)) :: a + character, pointer :: b => a +end program + +! { dg-error "must be of INTEGER type" " " { target *-*-* } 6 } +! { dg-error "does not have the TARGET attribute" " " { target *-*-* } 7 } diff --git a/gcc/testsuite/gfortran.dg/pr93714_2.f90 b/gcc/testsuite/gfortran.dg/pr93714_2.f90 new file mode 100644 index 00000000000..86658f28859 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr93714_2.f90 @@ -0,0 +1,11 @@ +! { dg-do compile } +! PR 93714 +! Original test case from G. Steinmetz + +program test + character((9.)) :: a + character(:), pointer :: b => a +end program + +! { dg-error "must be of INTEGER type" " " { target *-*-* } 6 } +! { dg-error "does not have the TARGET attribute" " " { target *-*-* } 7 } -- 2.30.2