From 90d715b0a524cb1dc534f470bc552915bb41663c Mon Sep 17 00:00:00 2001 From: Thomas Koenig Date: Thu, 11 Jan 2007 20:32:42 +0000 Subject: [PATCH] re PR libfortran/30415 (MINLOC, MAXLOC missing for integer kinds 1 and 2) 2007-01-11 Thomas Koenig 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 PR libfortran/30415 * minmaxloc_integer_kinds_1.f90: New test. From-SVN: r120685 --- gcc/fortran/ChangeLog | 9 ++++++++ gcc/fortran/iresolve.c | 26 ++++++++++++++++++++++ gcc/testsuite/ChangeLog | 5 +++++ .../gfortran.dg/minmaxloc_integer_kinds_1.f90 | 10 +++++++++ 4 files changed, 50 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/minmaxloc_integer_kinds_1.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 5d093c4..367e170 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,12 @@ +2007-01-11 Thomas Koenig + + 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 * simplify.c: Update copyright to 2007. diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c index 63741f2..4ded73d 100644 --- 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"; + /* 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); @@ -1385,6 +1398,19 @@ gfc_resolve_minloc (gfc_expr *f, gfc_expr *array, gfc_expr *dim, 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); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 7b9b375..daa212b 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2007-01-11 Thomas Koenig + + PR libfortran/30415 + * minmaxloc_integer_kinds_1.f90: New test. + 2007-01-11 Simon Martin 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 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 + -- 2.7.4