mirror of
git://gcc.gnu.org/git/gcc.git
synced 2025-03-20 19:01:12 +08:00
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:
parent
26fbc975c8
commit
b2890f04bd
@ -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
|
||||
|
@ -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)
|
||||
|
@ -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
|
||||
|
18
gcc/testsuite/gfortran.dg/char_pointer_assign_3.f90
Normal file
18
gcc/testsuite/gfortran.dg/char_pointer_assign_3.f90
Normal 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
|
@ -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
|
||||
|
Loading…
x
Reference in New Issue
Block a user