This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[Patch, fortran] PR31803 - Fix pointer => target(range)
- From: Tobias Burnus <burnus at net-b dot de>
- To: gcc-patches <gcc-patches at gcc dot gnu dot org>, "'fortran at gcc dot gnu dot org'" <fortran at gcc dot gnu dot org>
- Date: Fri, 04 May 2007 14:43:31 +0200
- Subject: [Patch, fortran] PR31803 - Fix pointer => target(range)
:ADDPATCH fortran:
This turned out to be trivial, a single NULL pointer check and
everything worked.
Build and check-gfortran tested on x86-64/Linux with no failures (but
st_function.f90).
Ok for the trunk?
Tobias
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.
Index: gcc/fortran/expr.c
===================================================================
--- gcc/fortran/expr.c (Revision 124415)
+++ gcc/fortran/expr.c (Arbeitskopie)
@@ -2553,6 +2553,7 @@ gfc_check_pointer_assign (gfc_expr *lval
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)
Index: gcc/testsuite/gfortran.dg/char_pointer_assign_3.f90
===================================================================
--- gcc/testsuite/gfortran.dg/char_pointer_assign_3.f90 (Revision 0)
+++ gcc/testsuite/gfortran.dg/char_pointer_assign_3.f90 (Revision 0)
@@ -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
Index: gcc/testsuite/gfortran.dg/char_result_2.f90
===================================================================
--- gcc/testsuite/gfortran.dg/char_result_2.f90 (Revision 124415)
+++ gcc/testsuite/gfortran.dg/char_result_2.f90 (Arbeitskopie)
@@ -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