From: Thomas Koenig <tkoenig@gcc.gnu.org>
Date: Sat, 19 Jan 2008 22:47:47 +0000 (+0000)
Subject: re PR fortran/34817 (mixed-kind "any" and "all" intrinsics with expressions)
X-Git-Tag: releases/gcc-4.3.0~530
X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=c613d54045e8d5d0b65a5163af59669d32cd3cf1;p=thirdparty%2Fgcc.git

re PR fortran/34817 (mixed-kind "any" and "all" intrinsics with expressions)

2008-01-19  Thomas Koenig  <tkoenig@gcc.gnu.org>

	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  <tkoenig@gcc.gnu.org>

	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
---

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 46c95e00f26b..11d9c2378a15 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+2008-01-19  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	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  <burnus@net-b.de>
 
 	PR fortran/34760
diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index bdb4054fe411..79b46e2501c1 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 96b2a6ceeb9c..5ea52a26f405 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,10 @@
+2008-01-19  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	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  <dave.anglin@nrc-cnrc.gc.ca>
 
 	* 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 000000000000..f1a14474034b
--- /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 000000000000..57df0cf6cbfb
--- /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