OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Fortran: handle explicit-shape specs with constant bounds [PR105954] 

gcc/fortran/ChangeLog:

	PR fortran/105954
	* decl.cc (variable_decl): Adjust upper bounds for explicit-shape
	specs with constant bound expressions to ensure non-negative
	extents.

gcc/testsuite/ChangeLog:

	PR fortran/105954
	* gfortran.dg/pr105954.f90: New test.

(cherry picked from commit a312407bd7)
This commit is contained in:
Harald Anlauf 2022-06-20 20:59:55 +02:00
parent 26ea506a1e
commit 6bcab64467
2 changed files with 38 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
gcc/fortran/decl.cc
View File

@ -2775,6 +2775,18 @@ variable_decl (int elem)
else
gfc_free_expr (n);
}
/* For an explicit-shape spec with constant bounds, ensure
that the effective upper bound is not lower than the
respective lower bound minus one. Otherwise adjust it so
that the extent is trivially derived to be zero. */
if (as->lower[i]->expr_type == EXPR_CONSTANT
&& as->upper[i]->expr_type == EXPR_CONSTANT
&& as->lower[i]->ts.type == BT_INTEGER
&& as->upper[i]->ts.type == BT_INTEGER
&& mpz_cmp (as->upper[i]->value.integer,
as->lower[i]->value.integer) < 0)
mpz_sub_ui (as->upper[i]->value.integer,
as->lower[i]->value.integer, 1);
}
}
}

26
gcc/testsuite/gfortran.dg/pr105954.f90 Normal file
View File

@ -0,0 +1,26 @@
! { dg-do compile }
! { dg-options "-fdump-tree-original" }
! PR fortran/105954 - ICE in gfc_element_size, at fortran/target-memory.cc:132
! Contributed by G.Steinmetz
program p
use iso_c_binding, only: c_float, c_sizeof
implicit none
integer, parameter :: n = -99
type t
real :: b(3,7:n)
end type
type, bind(c) :: u
real(c_float) :: b(3,7:n)
end type
type(t) :: d
type(u) :: e
integer, parameter :: k = storage_size(d)
integer, parameter :: m = sizeof(d)
integer, parameter :: l = c_sizeof(e)
if (k /= 0) stop 1
if (m /= 0) stop 2
if (l /= 0) stop 3
end
! { dg-final { scan-tree-dump-not "_gfortran_stop_numeric" "original" } }