diff options
author | Harald Anlauf <anlauf@gmx.de> | 2022-01-13 21:50:45 +0100 |
---|---|---|
committer | Harald Anlauf <anlauf@gmx.de> | 2022-01-14 19:16:04 +0100 |
commit | a4a8ae123cd70188e4b4bf5e288a84e0a76fb0fd (patch) | |
tree | 46dec75bfe04b8963eacf46225c147cb116bbbc2 | |
parent | 72332337e3d8acbb21398b8d123f1bfe77a8327e (diff) | |
download | gcc-a4a8ae123cd70188e4b4bf5e288a84e0a76fb0fd.zip gcc-a4a8ae123cd70188e4b4bf5e288a84e0a76fb0fd.tar.gz gcc-a4a8ae123cd70188e4b4bf5e288a84e0a76fb0fd.tar.bz2 |
Fortran: fix ICE overloading elemental intrinsics
gcc/fortran/ChangeLog:
PR fortran/103782
* expr.c (gfc_simplify_expr): Adjust logic for when to scalarize a
call of an intrinsic which may have been overloaded.
gcc/testsuite/ChangeLog:
PR fortran/103782
* gfortran.dg/overload_4.f90: New test.
-rw-r--r-- | gcc/fortran/expr.c | 5 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/overload_4.f90 | 27 |
2 files changed, 29 insertions, 3 deletions
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index a87686d..20b88a8 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -2219,10 +2219,9 @@ gfc_simplify_expr (gfc_expr *p, int type) && gfc_intrinsic_func_interface (p, 1) == MATCH_ERROR) return false; - if (p->expr_type == EXPR_FUNCTION) + if (p->symtree && (p->value.function.isym || p->ts.type == BT_UNKNOWN)) { - if (p->symtree) - isym = gfc_find_function (p->symtree->n.sym->name); + isym = gfc_find_function (p->symtree->n.sym->name); if (isym && isym->elemental) scalarize_intrinsic_call (p, false); } diff --git a/gcc/testsuite/gfortran.dg/overload_4.f90 b/gcc/testsuite/gfortran.dg/overload_4.f90 new file mode 100644 index 0000000..43207e3 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/overload_4.f90 @@ -0,0 +1,27 @@ +! { dg-do run } +! { dg-additional-options "-Wno-intrinsic-shadow" } +! PR fortran/103782 - ICE overloading an intrinsic like dble or real +! Contributed by Urban Jost + +program runtest + implicit none + interface dble + procedure to_double + end interface dble + interface real + procedure floor ! not really FLOOR... + end interface real + if (any (dble ([10.0d0,20.0d0]) - [10.0d0,20.0d0] /= 0.d0)) stop 1 + if (any (real ([1.5,2.5]) - [1.5,2.5] /= 0.0 )) stop 2 +contains + elemental function to_double (valuein) result(d_out) + doubleprecision,intent(in) :: valuein + doubleprecision :: d_out + d_out=valuein + end function to_double + elemental function floor (valuein) result(d_out) ! not really FLOOR... + real, intent(in) :: valuein + real :: d_out + d_out=valuein + end function floor +end program runtest |