Skip to content

R
riscv-gcc-1
Commit 69597e2f by Paul Thomas
Options

re PR fortran/87881 (gfortran.dg/inquiry_type_ref_(1.f08|3.f90) fail on darwin) 

2018-12-21  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/87881
	* expr.c (find_inquiry_ref): Loop through the inquiry refs in
	case there are two of them.
	(simplify_ref_chain): Return true after a successful call to
	find_inquiry_ref.

2018-12-21  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/87881
	* gfortran.dg/inquiry_part_ref_4.f90: New test.

From-SVN: r267337
parent 2f8df14d
Showing with 73 additions and 40 deletions
gcc/fortran/ChangeLog
2018-12-21 Paul Thomas <pault@gcc.gnu.org>
PR fortran/87881
* expr.c (find_inquiry_ref): Loop through the inquiry refs in
case there are two of them.
(simplify_ref_chain): Return true after a successful call to
find_inquiry_ref.
2018-12-19 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/87992
......@@ -125,7 +133,7 @@
2018-12-08 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/88357
* class.c (insert_component_ref): Check for NULL pointer and
* class.c (insert_component_ref): Check for NULL pointer and
previous error message issued.
* parse.c (parse_associate): Check for NULL pointer.
* resolve.c (resolve_assoc_var): Check for NULL pointer.
......@@ -2848,7 +2856,7 @@ notice and this notice are preserved.
2018-12-08 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/88357
* class.c (insert_component_ref): Check for NULL pointer and
* class.c (insert_component_ref): Check for NULL pointer and
previous error message issued.
* parse.c (parse_associate): Check for NULL pointer.
* resolve.c (resolve_assoc_var): Check for NULL pointer.
......
gcc/fortran/expr.c
......@@ -1730,56 +1730,61 @@ find_inquiry_ref (gfc_expr *p, gfc_expr **newp)
gfc_resolve_expr (tmp);
switch (inquiry->u.i)
/* In principle there can be more than one inquiry reference. */
for (; inquiry; inquiry = inquiry->next)
{
case INQUIRY_LEN:
if (tmp->ts.type != BT_CHARACTER)
goto cleanup;
switch (inquiry->u.i)
{
case INQUIRY_LEN:
if (tmp->ts.type != BT_CHARACTER)
goto cleanup;
if (!gfc_notify_std (GFC_STD_F2003, "LEN part_ref at %C"))
goto cleanup;
if (!gfc_notify_std (GFC_STD_F2003, "LEN part_ref at %C"))
goto cleanup;
if (!tmp->ts.u.cl->length
|| tmp->ts.u.cl->length->expr_type != EXPR_CONSTANT)
goto cleanup;
if (!tmp->ts.u.cl->length
|| tmp->ts.u.cl->length->expr_type != EXPR_CONSTANT)
goto cleanup;
*newp = gfc_copy_expr (tmp->ts.u.cl->length);
break;
*newp = gfc_copy_expr (tmp->ts.u.cl->length);
break;
case INQUIRY_KIND:
if (tmp->ts.type == BT_DERIVED || tmp->ts.type == BT_CLASS)
goto cleanup;
case INQUIRY_KIND:
if (tmp->ts.type == BT_DERIVED || tmp->ts.type == BT_CLASS)
goto cleanup;
if (!gfc_notify_std (GFC_STD_F2003, "KIND part_ref at %C"))
goto cleanup;
if (!gfc_notify_std (GFC_STD_F2003, "KIND part_ref at %C"))
goto cleanup;
*newp = gfc_get_int_expr (gfc_default_integer_kind,
NULL, tmp->ts.kind);
break;
*newp = gfc_get_int_expr (gfc_default_integer_kind,
NULL, tmp->ts.kind);
break;
case INQUIRY_RE:
if (tmp->ts.type != BT_COMPLEX || tmp->expr_type != EXPR_CONSTANT)
goto cleanup;
case INQUIRY_RE:
if (tmp->ts.type != BT_COMPLEX || tmp->expr_type != EXPR_CONSTANT)
goto cleanup;
if (!gfc_notify_std (GFC_STD_F2008, "RE part_ref at %C"))
goto cleanup;
if (!gfc_notify_std (GFC_STD_F2008, "RE part_ref at %C"))
goto cleanup;
*newp = gfc_get_constant_expr (BT_REAL, tmp->ts.kind, &tmp->where);
mpfr_set ((*newp)->value.real,
mpc_realref (p->value.complex), GFC_RND_MODE);
break;
*newp = gfc_get_constant_expr (BT_REAL, tmp->ts.kind, &tmp->where);
mpfr_set ((*newp)->value.real,
mpc_realref (p->value.complex), GFC_RND_MODE);
break;
case INQUIRY_IM:
if (tmp->ts.type != BT_COMPLEX || tmp->expr_type != EXPR_CONSTANT)
goto cleanup;
case INQUIRY_IM:
if (tmp->ts.type != BT_COMPLEX || tmp->expr_type != EXPR_CONSTANT)
goto cleanup;
if (!gfc_notify_std (GFC_STD_F2008, "IM part_ref at %C"))
goto cleanup;
if (!gfc_notify_std (GFC_STD_F2008, "IM part_ref at %C"))
goto cleanup;
*newp = gfc_get_constant_expr (BT_REAL, tmp->ts.kind, &tmp->where);
mpfr_set ((*newp)->value.real,
mpc_imagref (p->value.complex), GFC_RND_MODE);
break;
*newp = gfc_get_constant_expr (BT_REAL, tmp->ts.kind, &tmp->where);
mpfr_set ((*newp)->value.real,
mpc_imagref (p->value.complex), GFC_RND_MODE);
break;
}
tmp = gfc_copy_expr (*newp);
}
if (!(*newp))
......@@ -1970,7 +1975,7 @@ simplify_ref_chain (gfc_ref *ref, int type, gfc_expr **p)
gfc_replace_expr (*p, newp);
gfc_free_ref_list ((*p)->ref);
(*p)->ref = NULL;
break;
return true;;
default:
break;
......
gcc/testsuite/ChangeLog
2018-12-21 Paul Thomas <pault@gcc.gnu.org>
PR fortran/87881
* gfortran.dg/inquiry_part_ref_4.f90: New test.
2018-12-21 Andreas Krebbel <krebbel@linux.ibm.com>
* gcc.target/s390/vector/fp-signedint-convert-1.c: New test.
......
gcc/testsuite/gfortran.dg/inquiry_type_ref_4.f90 0 → 100644
! { dg-do compile }
! { dg-options "-fdump-tree-original" }
!
! Check the fix for PR87881.
!
complex(8) :: zi = (0,-1_8)
character(2) :: chr ='ab'
if (zi%re%kind .ne. kind (real (zi))) stop 1
if (chr%len%kind .ne. kind (len (chr))) stop 2
! After simplification there should only be the delarations for 'zi' and 'chr'
! { dg-final { scan-tree-dump-times "zi" 1 "original" } }
! { dg-final { scan-tree-dump-times "chr" 1 "original" } }
end
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