2007-01-11 Thomas Koenig <Thomas.Koenig@online.de>

	PR libfortran/30415
	* iresolve.c (gfc_resolve_maxloc):  If the rank
	of the return array is nonzero and we process an
	integer array smaller than default kind, coerce
	the array to default integer.
	* iresolve.c (gfc_resolve_minloc):  Likewise.

2007-01-11  Thomas Koenig  <Thomas.Koenig@online.de>

	PR libfortran/30415
	* minmaxloc_integer_kinds_1.f90:  New test.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@120685 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 5d093c4..367e170 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,12 @@
+2007-01-11  Thomas Koenig  <Thomas.Koenig@online.de>
+
+       PR libfortran/30415
+       * iresolve.c (gfc_resolve_maxloc):  If the rank
+       of the return array is nonzero and we process an
+       integer array smaller than default kind, coerce
+       the array to default integer.
+       * iresolve.c (gfc_resolve_minloc):  Likewise.
+

 2007-01-11  Brooks Moses  <brooks.moses@codesourcery.com>
 
        * simplify.c: Update copyright to 2007.
 2007-01-11  Brooks Moses  <brooks.moses@codesourcery.com>
 
        * simplify.c: Update copyright to 2007.

diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index 63741f2..4ded73d 100644 (file)
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -1231,6 +1231,19 @@ gfc_resolve_maxloc (gfc_expr *f, gfc_expr *array, gfc_expr *dim,
   else
     name = "maxloc";
 
   else
     name = "maxloc";
 

+  /* If the rank of the function is nonzero, we are going to call
+     a library function.  Coerce the argument to one of the
+     existing library functions for this case.  */
+
+  if (f->rank != 0 && array->ts.type == BT_INTEGER
+      && array->ts.kind < gfc_default_integer_kind)
+    {
+      gfc_typespec ts;
+      ts.type = BT_INTEGER;
+      ts.kind = gfc_default_integer_kind;
+      gfc_convert_type_warn (array, &ts, 2, 0);
+    }
+

   f->value.function.name
     = gfc_get_string (PREFIX ("%s%d_%d_%c%d"), name, dim != NULL, f->ts.kind,
                      gfc_type_letter (array->ts.type), array->ts.kind);
   f->value.function.name
     = gfc_get_string (PREFIX ("%s%d_%d_%c%d"), name, dim != NULL, f->ts.kind,
                      gfc_type_letter (array->ts.type), array->ts.kind);


@@ -1385,6 +1398,19 @@ gfc_resolve_minloc (gfc_expr *f, gfc_expr *array, gfc_expr *dim,
   else
     name = "minloc";
 
   else
     name = "minloc";
 

+  /* If the rank of the function is nonzero, we are going to call
+     a library function.  Coerce the argument to one of the
+     existing library functions for this case.  */
+
+  if (f->rank != 0 && array->ts.type == BT_INTEGER
+      && array->ts.kind < gfc_default_integer_kind)
+    {
+      gfc_typespec ts;
+      ts.type = BT_INTEGER;
+      ts.kind = gfc_default_integer_kind;
+      gfc_convert_type_warn (array, &ts, 2, 0);
+    }
+

   f->value.function.name
     = gfc_get_string (PREFIX ("%s%d_%d_%c%d"), name, dim != NULL, f->ts.kind,
                      gfc_type_letter (array->ts.type), array->ts.kind);
   f->value.function.name
     = gfc_get_string (PREFIX ("%s%d_%d_%c%d"), name, dim != NULL, f->ts.kind,
                      gfc_type_letter (array->ts.type), array->ts.kind);

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 7b9b375..daa212b 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2007-01-11  Thomas Koenig  <Thomas.Koenig@online.de>
+
+       PR libfortran/30415
+       * minmaxloc_integer_kinds_1.f90:  New test.
+

 2007-01-11  Simon Martin  <simartin@users.sourceforge.net>
 
        PR c++/29573
 2007-01-11  Simon Martin  <simartin@users.sourceforge.net>
 
        PR c++/29573

diff --git a/gcc/testsuite/gfortran.dg/minmaxloc_integer_kinds_1.f90 b/gcc/testsuite/gfortran.dg/minmaxloc_integer_kinds_1.f90
new file mode 100644 (file)
index 0000000..cbf84ec
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/minmaxloc_integer_kinds_1.f90
@@ -0,0 +1,10 @@
+! { dg-do link }
+! PR 30415 - minloc and maxloc for integer kinds=1 and 2 were missing
+! Test case by Harald Anlauf
+program gfcbug55
+  integer(kind=1) :: i1(4) = 1
+  integer(kind=2) :: i2(4) = 1
+  print *, minloc(i1), maxloc(i1)
+  print *, minloc(i2), maxloc(i2)
+end program gfcbug55
+