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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 71ec57ee17114a817f6245835458bb77d6404c04..b3b17fd86309844c5278b17b72ca687111d94278 100644 (file)
--- 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 a408229242dbfeda0fb2f0c6d486337eb29eec8e..9957a4629a0b97bc98eac4eeec8eda03a0b7e467 100644 (file)
--- 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 c55266ad9a135c68a067b0618eeb97db0fddeb8c..577bdc9883c889516f63f8bcbf4947099aea246b 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -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

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 (file)
index 0000000..21db2df
--- /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 0df43aa06bca503bba62b0130d9c0b02dba1a415..4127ecf94e9f9847fae11a42709e20e9e5821dba 100644 (file)
--- 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