procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Fortran: check types of source expressions before conversion [PR107215]

Browse source 
gcc/fortran/ChangeLog:

	PR fortran/107215
	* arith.cc (gfc_int2int): Check validity of type of source expr.
	(gfc_int2real): Likewise.
	(gfc_int2complex): Likewise.
	(gfc_real2int): Likewise.
	(gfc_real2real): Likewise.
	(gfc_complex2int): Likewise.
	(gfc_complex2real): Likewise.
	(gfc_complex2complex): Likewise.
	(gfc_log2log): Likewise.
	(gfc_log2int): Likewise.
	(gfc_int2log): Likewise.

gcc/testsuite/ChangeLog:

	PR fortran/107215
	* gfortran.dg/pr107215.f90: New test.
This commit is contained in:
Harald Anlauf 2022-10-11 20:37:42 +02:00
parent 23c3cbaed3
commit 53955284c0
2 changed files with 50 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

33
gcc/fortran/arith.cc
View file

@ -2040,6 +2040,9 @@ gfc_int2int (gfc_expr *src, int kind)
gfc_expr *result;
arith rc;
if (src->ts.type != BT_INTEGER)
return NULL;
result = gfc_get_constant_expr (BT_INTEGER, kind, &src->where);
mpz_set (result->value.integer, src->value.integer);
@ -2085,6 +2088,9 @@ gfc_int2real (gfc_expr *src, int kind)
gfc_expr *result;
arith rc;
if (src->ts.type != BT_INTEGER)
return NULL;
result = gfc_get_constant_expr (BT_REAL, kind, &src->where);
mpfr_set_z (result->value.real, src->value.integer, GFC_RND_MODE);
@ -2116,6 +2122,9 @@ gfc_int2complex (gfc_expr *src, int kind)
gfc_expr *result;
arith rc;
if (src->ts.type != BT_INTEGER)
return NULL;
result = gfc_get_constant_expr (BT_COMPLEX, kind, &src->where);
mpc_set_z (result->value.complex, src->value.integer, GFC_MPC_RND_MODE);
@ -2150,6 +2159,9 @@ gfc_real2int (gfc_expr *src, int kind)
arith rc;
bool did_warn = false;
if (src->ts.type != BT_REAL)
return NULL;
result = gfc_get_constant_expr (BT_INTEGER, kind, &src->where);
gfc_mpfr_to_mpz (result->value.integer, src->value.real, &src->where);
@ -2196,6 +2208,9 @@ gfc_real2real (gfc_expr *src, int kind)
arith rc;
bool did_warn = false;
if (src->ts.type != BT_REAL)
return NULL;
result = gfc_get_constant_expr (BT_REAL, kind, &src->where);
mpfr_set (result->value.real, src->value.real, GFC_RND_MODE);
@ -2310,6 +2325,9 @@ gfc_complex2int (gfc_expr *src, int kind)
arith rc;
bool did_warn = false;
if (src->ts.type != BT_COMPLEX)
return NULL;
result = gfc_get_constant_expr (BT_INTEGER, kind, &src->where);
gfc_mpfr_to_mpz (result->value.integer, mpc_realref (src->value.complex),
@ -2372,6 +2390,9 @@ gfc_complex2real (gfc_expr *src, int kind)
arith rc;
bool did_warn = false;
if (src->ts.type != BT_COMPLEX)
return NULL;
result = gfc_get_constant_expr (BT_REAL, kind, &src->where);
mpc_real (result->value.real, src->value.complex, GFC_RND_MODE);
@ -2439,6 +2460,9 @@ gfc_complex2complex (gfc_expr *src, int kind)
arith rc;
bool did_warn = false;
if (src->ts.type != BT_COMPLEX)
return NULL;
result = gfc_get_constant_expr (BT_COMPLEX, kind, &src->where);
mpc_set (result->value.complex, src->value.complex, GFC_MPC_RND_MODE);
@ -2504,6 +2528,9 @@ gfc_log2log (gfc_expr *src, int kind)
{
gfc_expr *result;
if (src->ts.type != BT_LOGICAL)
return NULL;
result = gfc_get_constant_expr (BT_LOGICAL, kind, &src->where);
result->value.logical = src->value.logical;
@ -2518,6 +2545,9 @@ gfc_log2int (gfc_expr *src, int kind)
{
gfc_expr *result;
if (src->ts.type != BT_LOGICAL)
return NULL;
result = gfc_get_constant_expr (BT_INTEGER, kind, &src->where);
mpz_set_si (result->value.integer, src->value.logical);
@ -2532,6 +2562,9 @@ gfc_int2log (gfc_expr *src, int kind)
{
gfc_expr *result;
if (src->ts.type != BT_INTEGER)
return NULL;
result = gfc_get_constant_expr (BT_LOGICAL, kind, &src->where);
result->value.logical = (mpz_cmp_si (src->value.integer, 0) != 0);

17
gcc/testsuite/gfortran.dg/pr107215.f90 Normal file
View file

@ -0,0 +1,17 @@
! { dg-do compile }
! PR fortran/107215 - ICE in gfc_real2real and gfc_complex2complex
! Contributed by G.Steinmetz
program p
double precision, parameter :: z = 1.0d0
complex :: x(1)
real :: y(1)
x = [real :: -'1'] * z ! { dg-error "Operand of unary numeric operator" }
y = z * [real :: -'1'] ! { dg-error "Operand of unary numeric operator" }
x = [real :: -(.true.)] * z ! { dg-error "Operand of unary numeric operator" }
y = z * [real :: -(.true.)] ! { dg-error "Operand of unary numeric operator" }
x = [complex :: -'1'] * z ! { dg-error "Operand of unary numeric operator" }
y = z * [complex :: -'1'] ! { dg-error "Operand of unary numeric operator" }
x = [complex :: -(.true.)] * z ! { dg-error "Operand of unary numeric operator" }
y = z * [complex :: -(.true.)] ! { dg-error "Operand of unary numeric operator" }
end