Commit 06119d69 by Mark Eggleston

[fortran] ICE assign character pointer to non target PR93714

An ICE occurred if an attempt was made to assign a pointer to a
character variable that has an length incorrectly specified using
a real constant and does not have the target attribute.

gcc/fortran/ChangeLog

	PR fortran/93714
	* expr.c (gfc_check_pointer_assign): Move check for
	matching character length to after checking the lvalue
	attributes for target or pointer.

gcc/testsuite/ChangeLog

	PR fortran/93714
	* gfortran.dg/char_pointer_assign_6.f90: Look for no target
	message instead of length mismatch.
	* gfortran.dg/pr93714_1.f90
	* gfortran.dg/pr93714_2.f90
parent fa1160f6
2020-02-18 Mark Eggleston <markeggleston@gcc.gnu.org>
PR fortran/93714
* expr.c (gfc_check_pointer_assign): Move check for
matching character length to after checking the lvalue
attributes for target or pointer.
2020-02-18 Steven G. Kargl <kargl@gcc.gnu.org> 2020-02-18 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/93601 PR fortran/93601
......
...@@ -4222,13 +4222,6 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue, ...@@ -4222,13 +4222,6 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue,
if (rvalue->expr_type == EXPR_NULL) if (rvalue->expr_type == EXPR_NULL)
return true; return true;
if (lvalue->ts.type == BT_CHARACTER)
{
bool t = gfc_check_same_strlen (lvalue, rvalue, "pointer assignment");
if (!t)
return false;
}
if (rvalue->expr_type == EXPR_VARIABLE && is_subref_array (rvalue)) if (rvalue->expr_type == EXPR_VARIABLE && is_subref_array (rvalue))
lvalue->symtree->n.sym->attr.subref_array_pointer = 1; lvalue->symtree->n.sym->attr.subref_array_pointer = 1;
...@@ -4284,6 +4277,13 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue, ...@@ -4284,6 +4277,13 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue,
} }
} }
if (lvalue->ts.type == BT_CHARACTER)
{
bool t = gfc_check_same_strlen (lvalue, rvalue, "pointer assignment");
if (!t)
return false;
}
if (is_pure && gfc_impure_variable (rvalue->symtree->n.sym)) if (is_pure && gfc_impure_variable (rvalue->symtree->n.sym))
{ {
gfc_error ("Bad target in pointer assignment in PURE " gfc_error ("Bad target in pointer assignment in PURE "
......
2020-02-18 Mark Eggleston <markeggleston@gcc.gnu.org>
PR fortran/93714
* gfortran.dg/char_pointer_assign_6.f90: Look for no target
message instead of length mismatch.
* gfortran.dg/pr93714_1.f90
* gfortran.dg/pr93714_2.f90
2020-02-18 Mark Eggleston <mark.eggleston@codethink.com> 2020-02-18 Mark Eggleston <mark.eggleston@codethink.com>
PR fortran/93601 PR fortran/93601
......
...@@ -6,6 +6,6 @@ program main ...@@ -6,6 +6,6 @@ program main
character (len=4) :: c character (len=4) :: c
s1 = 'abcd' s1 = 'abcd'
p1 => s1(2:3) ! { dg-error "Unequal character lengths \\(20/2\\)" } p1 => s1(2:3) ! { dg-error "Unequal character lengths \\(20/2\\)" }
p1 => c(1:) ! { dg-error "Unequal character lengths \\(20/4\\)" } p1 => c(1:) ! { dg-error "Pointer assignment target" }
p1 => c(:4) ! { dg-error "Unequal character lengths \\(20/4\\)" } p1 => c(:4) ! { dg-error "Pointer assignment target" }
end end
! { dg-do compile }
! PR 93714
! Original test case from G. Steinmetz
program test
character((1.)) :: a
character, pointer :: b => a
end program
! { dg-error "must be of INTEGER type" " " { target *-*-* } 6 }
! { dg-error "does not have the TARGET attribute" " " { target *-*-* } 7 }
! { dg-do compile }
! PR 93714
! Original test case from G. Steinmetz
program test
character((9.)) :: a
character(:), pointer :: b => a
end program
! { dg-error "must be of INTEGER type" " " { target *-*-* } 6 }
! { dg-error "does not have the TARGET attribute" " " { target *-*-* } 7 }
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment