diff options
| -rw-r--r-- | gcc/fortran/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/fortran/expr.c | 1 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 6 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/char_pointer_assign_3.f90 | 18 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/char_result_2.f90 | 4 |
5 files changed, 32 insertions, 2 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 71ec57ee171..b3b17fd8630 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,8 @@ +2007-05-04 Tobias Burnus <burnus@net-b.de> + + PR fortran/31803 + * expr.c (gfc_check_pointer_assign): Check for NULL pointer. + 2007-05-04 Jerry DeLisle <jvdelisle@gcc.gnu.org> PR fortran/31251 diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index a408229242d..9957a4629a0 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 c55266ad9a1..577bdc9883c 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,5 +1,11 @@ 2007-05-04 Tobias Burnus <burnus@net-b.de> + 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 <burnus@net-b.de> + PR fortran/25071 * gfortran.dg/char_length_3.f90: New test. * gfortran.dg/char_result_2.f90: Fix test. 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 00000000000..21db2df14a8 --- /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 0df43aa06bc..4127ecf94e9 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 |