From b2890f04bdb5f579c901c49aa7f544601806061f Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Fri, 4 May 2007 15:40:32 +0200 Subject: [PATCH] re PR fortran/31803 (ICE for character pointer => target(range)) 2007-05-04 Tobias Burnus PR fortran/31803 * expr.c (gfc_check_pointer_assign): Check for NULL pointer. 2007-05-04 Tobias Burnus PR fortran/31803 * gfortran.dg/char_pointer_assign_3.f90: New test. * gfortran.dg/char_result_2.f90: Re-enable test. From-SVN: r124419 --- gcc/fortran/ChangeLog | 5 +++++ gcc/fortran/expr.c | 1 + gcc/testsuite/ChangeLog | 6 ++++++ .../gfortran.dg/char_pointer_assign_3.f90 | 18 ++++++++++++++++++ gcc/testsuite/gfortran.dg/char_result_2.f90 | 4 ++-- 5 files changed, 32 insertions(+), 2 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/char_pointer_assign_3.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 71ec57ee1711..b3b17fd86309 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,8 @@ +2007-05-04 Tobias Burnus + + PR fortran/31803 + * expr.c (gfc_check_pointer_assign): Check for NULL pointer. + 2007-05-04 Jerry DeLisle PR fortran/31251 diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index a408229242db..9957a4629a0b 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -2553,6 +2553,7 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue) return SUCCESS; if (lvalue->ts.type == BT_CHARACTER + && lvalue->ts.cl && rvalue->ts.cl && lvalue->ts.cl->length && rvalue->ts.cl->length && abs (gfc_dep_compare_expr (lvalue->ts.cl->length, rvalue->ts.cl->length)) == 1) diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index c55266ad9a13..577bdc9883c8 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2007-05-04 Tobias Burnus + + PR fortran/31803 + * gfortran.dg/char_pointer_assign_3.f90: New test. + * gfortran.dg/char_result_2.f90: Re-enable test. + 2007-05-04 Tobias Burnus PR fortran/25071 diff --git a/gcc/testsuite/gfortran.dg/char_pointer_assign_3.f90 b/gcc/testsuite/gfortran.dg/char_pointer_assign_3.f90 new file mode 100644 index 000000000000..21db2df14a8c --- /dev/null +++ b/gcc/testsuite/gfortran.dg/char_pointer_assign_3.f90 @@ -0,0 +1,18 @@ +! { dg-do run } +! PR fortran/31803 +! Assigning a substring to a pointer + +program test + implicit none + character (len = 7), target :: textt + character (len = 7), pointer :: textp + character (len = 5), pointer :: textp2 + textp => textt + textp2 => textt(1:5) + if(len(textp) /= 7) call abort() + if(len(textp2) /= 5) call abort() + textp = 'aaaaaaa' + textp2 = 'bbbbbbb' + if(textp /= 'bbbbbaa') call abort() + if(textp2 /= 'bbbbb') call abort() +end program test diff --git a/gcc/testsuite/gfortran.dg/char_result_2.f90 b/gcc/testsuite/gfortran.dg/char_result_2.f90 index 0df43aa06bca..4127ecf94e9f 100644 --- a/gcc/testsuite/gfortran.dg/char_result_2.f90 +++ b/gcc/testsuite/gfortran.dg/char_result_2.f90 @@ -46,7 +46,7 @@ program main a = 42 textp => textt - ! textp2 => textt(1:50) ! needs fixed PR31803 + textp2 => textt(1:50) call test (f1 (textp), 70) call test (f2 (textp, textp), 95) @@ -55,7 +55,7 @@ program main call test (f5 (textp), 140) call test (f6 (textp), 29) - ! call indirect (textp2) ! needs fixed PR31803 + call indirect (textp2) contains function f3 (string) integer, parameter :: l1 = 30