From c613d54045e8d5d0b65a5163af59669d32cd3cf1 Mon Sep 17 00:00:00 2001 From: Thomas Koenig Date: Sat, 19 Jan 2008 22:47:47 +0000 Subject: [PATCH] re PR fortran/34817 (mixed-kind "any" and "all" intrinsics with expressions) 2008-01-19 Thomas Koenig PR fortran/34817 PR fortran/34838 * iresolve.c (gfc_resolve_all): Remove conversion of mask argument to kind=1 by removing call to resolve_mask_arg(). (gfc_resolve_any): Likewise. 2008-01-19 Thomas Koenig PR fortran/34817 PR fortran/34838 * gfortran.dg/any_all_1.f90: New test. * gfortran.dg/any_all_2.f90: New test. From-SVN: r131660 --- gcc/fortran/ChangeLog | 8 ++++++++ gcc/fortran/iresolve.c | 4 ---- gcc/testsuite/ChangeLog | 7 +++++++ gcc/testsuite/gfortran.dg/any_all_1.f90 | 18 ++++++++++++++++++ gcc/testsuite/gfortran.dg/any_all_2.f90 | 18 ++++++++++++++++++ 5 files changed, 51 insertions(+), 4 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/any_all_1.f90 create mode 100644 gcc/testsuite/gfortran.dg/any_all_2.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 46c95e00f26..11d9c2378a1 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +2008-01-19 Thomas Koenig + + PR fortran/34817 + PR fortran/34838 + * iresolve.c (gfc_resolve_all): Remove conversion of mask + argument to kind=1 by removing call to resolve_mask_arg(). + (gfc_resolve_any): Likewise. + 2008-01-19 Tobias Burnus PR fortran/34760 diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c index bdb4054fe41..79b46e2501c 100644 --- a/gcc/fortran/iresolve.c +++ b/gcc/fortran/iresolve.c @@ -256,8 +256,6 @@ gfc_resolve_all (gfc_expr *f, gfc_expr *mask, gfc_expr *dim) f->shape = gfc_copy_shape_excluding (mask->shape, mask->rank, dim); } - resolve_mask_arg (mask); - f->value.function.name = gfc_get_string (PREFIX ("all_%c%d"), gfc_type_letter (mask->ts.type), mask->ts.kind); @@ -306,8 +304,6 @@ gfc_resolve_any (gfc_expr *f, gfc_expr *mask, gfc_expr *dim) f->shape = gfc_copy_shape_excluding (mask->shape, mask->rank, dim); } - resolve_mask_arg (mask); - f->value.function.name = gfc_get_string (PREFIX ("any_%c%d"), gfc_type_letter (mask->ts.type), mask->ts.kind); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 96b2a6ceeb9..5ea52a26f40 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,10 @@ +2008-01-19 Thomas Koenig + + PR fortran/34817 + PR fortran/34838 + * gfortran.dg/any_all_1.f90: New test. + * gfortran.dg/any_all_2.f90: New test. + 2008-01-19 John David Anglin * g++.dg/eh/ia64-2.C: Place "dg-do run" statement before diff --git a/gcc/testsuite/gfortran.dg/any_all_1.f90 b/gcc/testsuite/gfortran.dg/any_all_1.f90 new file mode 100644 index 00000000000..f1a14474034 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/any_all_1.f90 @@ -0,0 +1,18 @@ +! { dg-do run } +! PR 34817 - the wrong library function was called, +! leading to garbage in the return value +program main + real, dimension(2,2) :: a + logical(kind=4), dimension(2) :: b + integer, dimension(2) :: i + equivalence (b,i) + data a /1.0, 2.0, -0.1, -0.2 / + + i = 16843009 ! Initialize i to put junk into b + b = any(a>0.5,dim=1) + if (b(2) .or. .not. b(1)) call abort + + i = 16843009 ! Initialize i to put junk into b + b = all(a>0.5,dim=1) + if (b(2) .or. .not. b(1)) call abort +end program main diff --git a/gcc/testsuite/gfortran.dg/any_all_2.f90 b/gcc/testsuite/gfortran.dg/any_all_2.f90 new file mode 100644 index 00000000000..57df0cf6cbf --- /dev/null +++ b/gcc/testsuite/gfortran.dg/any_all_2.f90 @@ -0,0 +1,18 @@ +! { dg-do compile } +! PR 34838 - this failed with "Can't convert LOGICAL(1) to LOGICAL(1) +! Test case contributed by Manfred Schwab. +program main + Logical(kind=1) :: bmp(1),bmpv(1) + + bmp(1)=.false. + bmpv(1)=.true. + + if ( ANY(bmp(1:1) .NEQV. bmpv(1:1)) ) then + print*,"hello" + end if + + if ( ALL(bmp(1:1) .NEQV. bmpv(1:1)) ) then + print*,"hello" + end if + +end program main -- 2.30.2