diff --git a/gcc/fortran/arith.cc b/gcc/fortran/arith.cc index 086b1f856b1..9e079e42995 100644 --- a/gcc/fortran/arith.cc +++ b/gcc/fortran/arith.cc @@ -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); diff --git a/gcc/testsuite/gfortran.dg/pr107215.f90 b/gcc/testsuite/gfortran.dg/pr107215.f90 new file mode 100644 index 00000000000..2c2a0ca7502 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr107215.f90 @@ -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