TeamHeptaMirrors/gcc
1
0
Fork 1
mirror of https://github.com/gcc-mirror/gcc.git synced 2026-05-06 14:59:39 +02:00
Code Issues Packages Projects Releases Wiki Activity

Fortran: Minor PDT cleanup and fix in gfc_simplify_exp [PR115315]

Browse Source 
2026-03-26  Paul Thomas  <pault@gcc.gnu.org>

gcc/fortran
	PR fortran/115315
	* decl.cc (insert_parameter_exprs): Make strcmp condition more
	concise.
	(gfc_get_pdt_instance): Use gf_replace_expr where possible and
	use return value of gfc_simplify_expr. Correct error in which
	params->expr was being simplified instead of c2->initializer.
	* expr.cc (gfc_simplify_expr): If the substring 'start' value
	is less than zero, it is clearly out of range and so return
	false.

gcc/testsuite/
	PR fortran/115315
	* gfortran.dg/pdt_90.f03: New test.
This commit is contained in:
Paul Thomas
2026-03-26 18:50:13 +00:00
parent 97682f93d7
commit 9780a52dff
3 changed files with 44 additions and 13 deletions
Download Patch File Download Diff File Expand all files Collapse all files

28
gcc/fortran/decl.cc
View File

@@ -3931,14 +3931,13 @@ insert_parameter_exprs (gfc_expr* e, gfc_symbol* sym ATTRIBUTE_UNUSED,
|| (e->expr_type == EXPR_FUNCTION && e->symtree->n.sym))
{
for (param = type_param_spec_list; param; param = param->next)
if (strcmp (e->symtree->n.sym->name, param->name) == 0)
if (!strcmp (e->symtree->n.sym->name, param->name))
break;
if (param && param->expr)
{
copy = gfc_copy_expr (param->expr);
*e = *copy;
free (copy);
gfc_replace_expr (e, copy);
/* Catch variables declared without a value expression. */
if (e->expr_type == EXPR_VARIABLE && e->ts.type == BT_PROCEDURE)
e->ts = e->symtree->n.sym->ts;
@@ -4456,14 +4455,16 @@ gfc_get_pdt_instance (gfc_actual_arglist *param_list, gfc_symbol **sym,
gfc_expr *e;
e = gfc_copy_expr (c1->as->lower[i]);
gfc_insert_kind_parameter_exprs (e);
gfc_simplify_expr (e, 1);
gfc_free_expr (c2->as->lower[i]);
c2->as->lower[i] = e;
if (gfc_simplify_expr (e, 1))
gfc_replace_expr (c2->as->lower[i], e);
else
gfc_free_expr (e);
e = gfc_copy_expr (c1->as->upper[i]);
gfc_insert_kind_parameter_exprs (e);
gfc_simplify_expr (e, 1);
gfc_free_expr (c2->as->upper[i]);
c2->as->upper[i] = e;
if (gfc_simplify_expr (e, 1))
gfc_replace_expr (c2->as->upper[i], e);
else
gfc_free_expr (e);
}
c2->attr.pdt_array = 1;
@@ -4483,9 +4484,10 @@ gfc_get_pdt_instance (gfc_actual_arglist *param_list, gfc_symbol **sym,
gfc_expr *e;
e = gfc_copy_expr (c1->ts.u.cl->length);
gfc_insert_kind_parameter_exprs (e);
gfc_simplify_expr (e, 1);
gfc_free_expr (c2->ts.u.cl->length);
c2->ts.u.cl->length = e;
if (gfc_simplify_expr (e, 1))
gfc_replace_expr (c2->ts.u.cl->length, e);
else
gfc_free_expr (e);
c2->attr.pdt_string = 1;
}
@@ -4530,7 +4532,7 @@ gfc_get_pdt_instance (gfc_actual_arglist *param_list, gfc_symbol **sym,
if (!s)
gfc_insert_parameter_exprs (c2->initializer,
type_param_spec_list);
gfc_simplify_expr (params->expr, 1);
gfc_simplify_expr (c2->initializer, 1);
}
}

3
gcc/fortran/expr.cc
View File

@@ -2506,6 +2506,9 @@ gfc_simplify_expr (gfc_expr *p, int type)
start--; /* Convert from one-based to zero-based. */
}
if (start < 0)
return false;
end = p->value.character.length;
if (p->ref && p->ref->u.ss.end)
gfc_extract_hwi (p->ref->u.ss.end, &end);

26
gcc/testsuite/gfortran.dg/pdt_90.f03 Normal file
View File

@@ -0,0 +1,26 @@
! { dg-do compile }
! { dg-options "-fdump-tree-original" }
!
! Check the fix for PR115315.f90 in which line 14 caused the error,
! "Argument of IACHAR at (1) must be of length one".
!
! Contributed by David Binderman <dcb314@hotmail.com>
!
call p2
contains
subroutine p2
type t1(n1,n2)
integer,kind :: n1,n2
integer :: c2(iachar('ABCDEFGHIJ'(n1:n2)))
end type
type(t1(4,4)) :: x
if (char (size (x%c2, 1)) .ne. "D") then
print *, "Wrong!"
else
print *, "Right"
endif
end
end
! { dg-final { scan-tree-dump-times "Wrong" 0 "original" } }
! { dg-final { scan-tree-dump-times "Right" 1 "original" } }