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

gcc/fortran/ChangeLog

+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

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)

gcc/testsuite/ChangeLog

 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.

gcc/testsuite/gfortran.dg/char_pointer_assign_3.f90

+! { 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

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