re PR fortran/31803 (ICE for character pointer => target(range))

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  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.

From-SVN: r124419
This commit is contained in:
Tobias Burnus 2007-05-04 15:40:32 +02:00 committed by Tobias Burnus
parent 26fbc975c8
commit b2890f04bd
5 changed files with 32 additions and 2 deletions

View File

@ -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

View File

@ -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)

View File

@ -1,3 +1,9 @@
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

View File

@ -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

View File

@ -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