aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
Diffstat (limited to 'gcc')
-rw-r--r--gcc/fortran/ChangeLog13
-rw-r--r--gcc/fortran/check.c2
-rw-r--r--gcc/fortran/iresolve.c22
-rw-r--r--gcc/fortran/trans-intrinsic.c32
-rw-r--r--gcc/testsuite/ChangeLog12
-rw-r--r--gcc/testsuite/gfortran.dg/maxval_char_1.f9042
-rw-r--r--gcc/testsuite/gfortran.dg/maxval_char_2.f9040
-rw-r--r--gcc/testsuite/gfortran.dg/maxval_char_3.f9069
-rw-r--r--gcc/testsuite/gfortran.dg/maxval_char_4.f9069
-rw-r--r--gcc/testsuite/gfortran.dg/minval_char_1.f9040
-rw-r--r--gcc/testsuite/gfortran.dg/minval_char_2.f9042
-rw-r--r--gcc/testsuite/gfortran.dg/minval_char_3.f9069
-rw-r--r--gcc/testsuite/gfortran.dg/minval_char_4.f9072
13 files changed, 514 insertions, 10 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index e5865dc..e0dd795 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,16 @@
+2017-12-03 Thomas Koenig <tkoenig@gcc.gnu.org>
+
+ PR fortran/36313
+ * check.c (gfc_check_minval_maxval): Use
+ int_orLreal_or_char_check_f2003 for array argument.
+ * iresolve.c (gfc_resolve_maxval): Insert number in
+ function name for character arguments.
+ (gfc_resolve_minval): Likewise.
+ * trans-intrinsic.c (gfc_conv_intrinsic_minmaxloc):
+ Fix comment.
+ (gfc_conv_intrinsic_minmaxval): Resort arguments and call library
+ function if dealing with a character function.
+
2017-12-01 Qing Zhao <qing.zhao@oracle.com>
* decl.c (gfc_get_pdt_instance): Adjust the call to sprintf
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 2928172..eda7407 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -3317,7 +3317,7 @@ check_reduction (gfc_actual_arglist *ap)
bool
gfc_check_minval_maxval (gfc_actual_arglist *ap)
{
- if (!int_or_real_check (ap->expr, 0)
+ if (!int_or_real_or_char_check_f2003 (ap->expr, 0)
|| !array_check (ap->expr, 0))
return false;
diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index be1c35b..3226a88 100644
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -1823,9 +1823,14 @@ gfc_resolve_maxval (gfc_expr *f, gfc_expr *array, gfc_expr *dim,
else
name = "maxval";
- f->value.function.name
- = gfc_get_string (PREFIX ("%s_%c%d"), name,
- gfc_type_letter (array->ts.type), array->ts.kind);
+ if (array->ts.type != BT_CHARACTER)
+ f->value.function.name
+ = gfc_get_string (PREFIX ("%s_%c%d"), name,
+ gfc_type_letter (array->ts.type), array->ts.kind);
+ else
+ f->value.function.name
+ = gfc_get_string (PREFIX ("%s%d_%c%d"), name, f->rank != 0,
+ gfc_type_letter (array->ts.type), array->ts.kind);
}
@@ -2023,9 +2028,14 @@ gfc_resolve_minval (gfc_expr *f, gfc_expr *array, gfc_expr *dim,
else
name = "minval";
- f->value.function.name
- = gfc_get_string (PREFIX ("%s_%c%d"), name,
- gfc_type_letter (array->ts.type), array->ts.kind);
+ if (array->ts.type != BT_CHARACTER)
+ f->value.function.name
+ = gfc_get_string (PREFIX ("%s_%c%d"), name,
+ gfc_type_letter (array->ts.type), array->ts.kind);
+ else
+ f->value.function.name
+ = gfc_get_string (PREFIX ("%s%d_%c%d"), name, f->rank != 0,
+ gfc_type_letter (array->ts.type), array->ts.kind);
}
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 90d5e59..c4aad1d 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -4571,7 +4571,7 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, enum tree_code op)
actual = expr->value.function.actual;
arrayexpr = actual->expr;
- /* Special case for character maxval. Remove unneeded actual
+ /* Special case for character maxloc. Remove unneeded actual
arguments, then call a library function. */
if (arrayexpr->ts.type == BT_CHARACTER)
@@ -5039,6 +5039,34 @@ gfc_conv_intrinsic_minmaxval (gfc_se * se, gfc_expr * expr, enum tree_code op)
return;
}
+ actual = expr->value.function.actual;
+ arrayexpr = actual->expr;
+
+ if (arrayexpr->ts.type == BT_CHARACTER)
+ {
+ gfc_actual_arglist *a2, *a3;
+ a2 = actual->next; /* dim */
+ a3 = a2->next; /* mask */
+ if (a2->expr == NULL || expr->rank == 0)
+ {
+ if (a3->expr == NULL)
+ actual->next = NULL;
+ else
+ {
+ actual->next = a3;
+ a2->next = NULL;
+ }
+ gfc_free_actual_arglist (a2);
+ }
+ else
+ if (a3->expr == NULL)
+ {
+ a2->next = NULL;
+ gfc_free_actual_arglist (a3);
+ }
+ gfc_conv_intrinsic_funcall (se, expr);
+ return;
+ }
type = gfc_typenode_for_spec (&expr->ts);
/* Initialize the result. */
limit = gfc_create_var (type, "limit");
@@ -5087,8 +5115,6 @@ gfc_conv_intrinsic_minmaxval (gfc_se * se, gfc_expr * expr, enum tree_code op)
gfc_add_modify (&se->pre, limit, tmp);
/* Walk the arguments. */
- actual = expr->value.function.actual;
- arrayexpr = actual->expr;
arrayss = gfc_walk_expr (arrayexpr);
gcc_assert (arrayss != gfc_ss_terminator);
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 792d1b9..de46b38 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,15 @@
+2017-12-03 Thomas Koenig <tkoenig@gcc.gnu.org>
+
+ PR fortran/36313
+ * gfortran.dg/maxval_char_1.f90: New test.
+ * gfortran.dg/maxval_char_2.f90: New test.
+ * gfortran.dg/maxval_char_3.f90: New test.
+ * gfortran.dg/maxval_char_4.f90: New test.
+ * gfortran.dg/minval_char_1.f90: New test.
+ * gfortran.dg/minval_char_2.f90: New test.
+ * gfortran.dg/minval_char_3.f90: New test.
+ * gfortran.dg/minval_char_4.f90: New test.
+
2017-12-03 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR fortran/831916
diff --git a/gcc/testsuite/gfortran.dg/maxval_char_1.f90 b/gcc/testsuite/gfortran.dg/maxval_char_1.f90
new file mode 100644
index 0000000..24b5336
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/maxval_char_1.f90
@@ -0,0 +1,42 @@
+! { dg-do run }
+program main
+ implicit none
+ integer, parameter :: n=5, m=3
+ character(len=5), dimension(n) :: a
+ character(len=5), dimension(n,m) :: b
+ character(len=5) :: res
+ integer, dimension(n,m) :: v
+ real, dimension(n,m) :: r
+ integer :: i,j
+ logical, dimension(n,m) :: mask
+ character(len=5), dimension(:,:), allocatable :: empty
+ character(len=5) , parameter :: all_zero = achar(0) // achar(0) // achar(0) // achar(0) // achar(0)
+ logical :: smask
+
+ write (unit=a,fmt='(I5.5)') (21-i*i+6*i,i=1,n)
+ res = maxval(a)
+ if (res /= '00030') call abort
+ res = maxval(a,dim=1)
+ if (res /= '00030') call abort
+ do
+ call random_number(r)
+ if (count(r>0.2) > 1) exit
+ end do
+ v = int(r * 100)
+ write (unit=b,fmt='(I5.5)') v
+ write (unit=res,fmt='(I5.5)') maxval(v)
+ if (res /= maxval(b)) call abort
+ smask = .true.
+ if (res /= maxval(b, smask)) call abort
+ smask = .false.
+ if (all_zero /= maxval(b, smask)) call abort
+
+ mask = v < 30
+ write (unit=res,fmt='(I5.5)') maxval(v,mask)
+ if (res /= maxval(b, mask)) call abort
+ mask = .false.
+ if (maxval(b, mask) /= all_zero) call abort
+ allocate (empty(0:3,0))
+ res = maxval(empty)
+ if (res /= all_zero) call abort
+end program main
diff --git a/gcc/testsuite/gfortran.dg/maxval_char_2.f90 b/gcc/testsuite/gfortran.dg/maxval_char_2.f90
new file mode 100644
index 0000000..750d18e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/maxval_char_2.f90
@@ -0,0 +1,40 @@
+! { dg-do run }
+program main
+ implicit none
+ integer, parameter :: n=5, m=3
+ character(kind=4,len=5), dimension(n) :: a
+ character(kind=4,len=5), dimension(n,m) :: b
+ character(kind=4,len=5) :: res
+ integer, dimension(n,m) :: v
+ real, dimension(n,m) :: r
+ integer :: i,j
+ logical, dimension(n,m) :: mask
+ character(kind=4,len=5), dimension(:,:), allocatable :: empty
+ character(kind=4,len=5) , parameter :: all_zero = achar(0) // achar(0) // achar(0) // achar(0) // achar(0)
+ logical :: smask
+
+ write (unit=a,fmt='(I5.5)') (21-i*i+6*i,i=1,n)
+ res = maxval(a)
+ if (res /= 4_'00030') call abort
+ do
+ call random_number(r)
+ if (count(r>0.2) > 1) exit
+ end do
+ v = int(r * 100)
+ write (unit=b,fmt='(I5.5)') v
+ write (unit=res,fmt='(I5.5)') maxval(v)
+ if (res /= maxval(b)) call abort
+ smask = .true.
+ if (res /= maxval(b, smask)) call abort
+ smask = .false.
+ if (all_zero /= maxval(b, smask)) call abort
+
+ mask = v < 30
+ write (unit=res,fmt='(I5.5)') maxval(v,mask)
+ if (res /= maxval(b, mask)) call abort
+ mask = .false.
+ if (maxval(b, mask) /= all_zero) call abort
+ allocate (empty(0:3,0))
+ res = maxval(empty)
+ if (res /= all_zero) call abort
+end program main
diff --git a/gcc/testsuite/gfortran.dg/maxval_char_3.f90 b/gcc/testsuite/gfortran.dg/maxval_char_3.f90
new file mode 100644
index 0000000..3fd5aa5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/maxval_char_3.f90
@@ -0,0 +1,69 @@
+! { dg-do run }
+program main
+ implicit none
+ integer, parameter :: n=5
+ character(len=6), dimension(n,n) :: a
+ integer, dimension(n,n) :: v
+ character(len=6), dimension(n) :: r1, r2
+ character(len=6), dimension(:,:), allocatable :: a_alloc
+ integer, dimension(:,:), allocatable :: v_alloc
+ character(len=6), parameter :: zero = achar(0) // achar(0) // achar(0) // achar(0) // achar(0) // achar(0)
+ integer :: i
+ character(len=6),dimension(1) :: ret
+ logical, dimension(n,n) :: mask
+ logical :: smask
+
+ v = reshape([(i*i+200-17*i,i=1,n*n)],shape(v))
+ write (unit=a,fmt='(I6.6)') (i*i+200-17*i,i=1,n*n)
+
+ r1 = maxval(a,dim=1)
+ write (unit=r2,fmt='(I6.6)') maxval(v,dim=1)
+ if (any (r1 /= r2)) call abort
+ r1 = 'x'
+ write (unit=r1,fmt='(I6.6)') maxval(v,dim=1)
+ if (any (r1 /= r2)) call abort
+
+ r1 = 'y'
+ r1 = maxval(a,dim=2)
+ write (unit=r2,fmt='(I6.6)') maxval(v,dim=2)
+ if (any (r1 /= r2)) call abort
+ r1 = 'z'
+ write (unit=r1,fmt='(I6.6)') maxval(v,dim=2)
+ if (any (r1 /= r2)) call abort
+
+ allocate (a_alloc(0,1), v_alloc(0,1))
+ ret = 'what'
+ ret = maxval(a_alloc,dim=1)
+ if (ret(1) /= zero) call abort
+
+ r1 = 'qq'
+ r1 = maxval(a, dim=1, mask=a>"000200");
+ if (any(r1 /= zero .neqv. maxval(v,dim=1, mask=v>200) > 0)) call abort
+ if (any(maxval(a, dim=1, mask=a>"000200") /= zero .neqv. maxval(v,dim=1, mask=v>200) > 0)) call abort
+
+ r1 = 'rr'
+ r1 = maxval(a, dim=2, mask=a>"000200");
+ if (any(r1 /= zero .neqv. maxval(v,dim=2, mask=v>200) > 0)) call abort
+ if (any(maxval(a, dim=2, mask=a>"000200") /= zero .neqv. maxval(v,dim=2, mask=v>200) > 0)) call abort
+
+ mask = .true.
+ forall (i=1:n)
+ mask(i,i) = .false.
+ end forall
+
+ r1 = 'aa'
+ r1 = maxval(a, dim=1, mask=mask)
+ write(unit=r2,fmt='(I6.6)') maxval(v,dim=1, mask=mask)
+ if (any(r1 /= r2)) call abort
+
+ r1 = 'xyz'
+ smask = .true.
+ r1 = maxval(a, dim=1, mask=smask)
+ write (unit=r2,fmt='(I6.6)') maxval(v,dim=1)
+ if (any (r1 /= r2)) call abort
+
+ smask = .false.
+ r1 = 'foobar'
+ r1 = maxval(a, dim=1, mask=smask)
+ if (any(r1 /= zero)) call abort
+end program main
diff --git a/gcc/testsuite/gfortran.dg/maxval_char_4.f90 b/gcc/testsuite/gfortran.dg/maxval_char_4.f90
new file mode 100644
index 0000000..076fba5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/maxval_char_4.f90
@@ -0,0 +1,69 @@
+! { dg-do run }
+program main
+ implicit none
+ integer, parameter :: n=5
+ character(kind=4,len=6), dimension(n,n) :: a
+ integer, dimension(n,n) :: v
+ character(kind=4,len=6), dimension(n) :: r1, r2
+ character(kind=4,len=6), dimension(:,:), allocatable :: a_alloc
+ integer, dimension(:,:), allocatable :: v_alloc
+ character(kind=4,len=6), parameter :: zero = achar(0,4) // achar(0,4) // achar(0,4) // achar(0,4) // achar(0,4) // achar(0,4)
+ integer :: i
+ character(kind=4,len=6),dimension(1) :: ret
+ logical, dimension(n,n) :: mask
+ logical :: smask
+
+ v = reshape([(i*i+200-17*i,i=1,n*n)],shape(v))
+ write (unit=a,fmt='(I6.6)') (i*i+200-17*i,i=1,n*n)
+
+ r1 = maxval(a,dim=1)
+ write (unit=r2,fmt='(I6.6)') maxval(v,dim=1)
+ if (any (r1 /= r2)) call abort
+ r1 = 4_'x'
+ write (unit=r1,fmt='(I6.6)') maxval(v,dim=1)
+ if (any (r1 /= r2)) call abort
+
+ r1 = 4_'y'
+ r1 = maxval(a,dim=2)
+ write (unit=r2,fmt='(I6.6)') maxval(v,dim=2)
+ if (any (r1 /= r2)) call abort
+ r1 = 4_'z'
+ write (unit=r1,fmt='(I6.6)') maxval(v,dim=2)
+ if (any (r1 /= r2)) call abort
+
+ allocate (a_alloc(0,1), v_alloc(0,1))
+ ret = 4_'what'
+ ret = maxval(a_alloc,dim=1)
+ if (ret(1) /= zero) call abort
+
+ r1 = 4_'qq'
+ r1 = maxval(a, dim=1, mask=a>4_"000200");
+ if (any(r1 /= zero .neqv. maxval(v,dim=1, mask=v>200) > 0)) call abort
+ if (any(maxval(a, dim=1, mask=a>4_"000200") /= zero .neqv. maxval(v,dim=1, mask=v>200) > 0)) call abort
+
+ r1 = 4_'rr'
+ r1 = maxval(a, dim=2, mask=a>4_"000200");
+ if (any(r1 /= zero .neqv. maxval(v,dim=2, mask=v>200) > 0)) call abort
+ if (any(maxval(a, dim=2, mask=a>4_"000200") /= zero .neqv. maxval(v,dim=2, mask=v>200) > 0)) call abort
+
+ mask = .true.
+ forall (i=1:n)
+ mask(i,i) = .false.
+ end forall
+
+ r1 = 4_'aa'
+ r1 = maxval(a, dim=1, mask=mask)
+ write(unit=r2,fmt='(I6.6)') maxval(v,dim=1, mask=mask)
+ if (any(r1 /= r2)) call abort
+
+ r1 = 4_'xyz'
+ smask = .true.
+ r1 = maxval(a, dim=1, mask=smask)
+ write (unit=r2,fmt='(I6.6)') maxval(v,dim=1)
+ if (any (r1 /= r2)) call abort
+
+ smask = .false.
+ r1 = 4_'foobar'
+ r1 = maxval(a, dim=1, mask=smask)
+ if (any(r1 /= zero)) call abort
+end program main
diff --git a/gcc/testsuite/gfortran.dg/minval_char_1.f90 b/gcc/testsuite/gfortran.dg/minval_char_1.f90
new file mode 100644
index 0000000..6ffab4e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/minval_char_1.f90
@@ -0,0 +1,40 @@
+! { dg-do run }
+program main
+ implicit none
+ integer, parameter :: n=5, m=3
+ character(len=5), dimension(n) :: a
+ character(len=5), dimension(n,m) :: b
+ character(len=5) :: res
+ integer, dimension(n,m) :: v
+ real, dimension(n,m) :: r
+ integer :: i,j
+ logical, dimension(n,m) :: mask
+ character(len=5), dimension(:,:), allocatable :: empty
+ character(len=5) , parameter :: all_full = achar(255) // achar(255) // achar(255) // achar(255) // achar(255)
+ logical :: smask
+
+ write (unit=a,fmt='(I5.5)') (21-i*i+6*i,i=1,n)
+ res = minval(a)
+ if (res /= '00026') call abort
+ do
+ call random_number(r)
+ if (count(r<0.2) > 1) exit
+ end do
+ v = int(r * 100)
+ write (unit=b,fmt='(I5.5)') v
+ write (unit=res,fmt='(I5.5)') minval(v)
+ if (res /= minval(b)) call abort
+ smask = .true.
+ if (res /= minval(b, smask)) call abort
+ smask = .false.
+ if (all_full /= minval(b, smask)) call abort
+
+ mask = v < 30
+ write (unit=res,fmt='(I5.5)') minval(v,mask)
+ if (res /= minval(b, mask)) call abort
+ mask = .false.
+ if (minval(b, mask) /= all_full) call abort
+ allocate (empty(0:3,0))
+ res = minval(empty)
+ if (res /= all_full) call abort
+end program main
diff --git a/gcc/testsuite/gfortran.dg/minval_char_2.f90 b/gcc/testsuite/gfortran.dg/minval_char_2.f90
new file mode 100644
index 0000000..82661f0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/minval_char_2.f90
@@ -0,0 +1,42 @@
+! { dg-do run }
+program main
+ implicit none
+ integer, parameter :: n=5, m=3
+ character(kind=4,len=5), dimension(n) :: a
+ character(kind=4,len=5), dimension(n,m) :: b
+ character(kind=4,len=5) :: res
+ integer, dimension(n,m) :: v
+ real, dimension(n,m) :: r
+ integer :: i,j
+ logical, dimension(n,m) :: mask
+ character(kind=4,len=5), dimension(:,:), allocatable :: empty
+ integer(kind=4), dimension(5) :: kmin = [-1, -1, -1, -1, -1]
+ character(kind=4,len=5) :: all_full
+ logical :: smask
+
+ all_full = transfer(kmin,all_full)
+ write (unit=a,fmt='(I5.5)') (21-i*i+6*i,i=1,n)
+ res = minval(a)
+ if (res /= 4_'00026') call abort
+ do
+ call random_number(r)
+ if (count(r>0.2) > 1) exit
+ end do
+ v = int(r * 100)
+ write (unit=b,fmt='(I5.5)') v
+ write (unit=res,fmt='(I5.5)') minval(v)
+ if (res /= minval(b)) call abort
+ smask = .true.
+ if (res /= minval(b, smask)) call abort
+ smask = .false.
+ if (all_full /= minval(b, smask)) call abort
+
+ mask = v < 30
+ write (unit=res,fmt='(I5.5)') minval(v,mask)
+ if (res /= minval(b, mask)) call abort
+ mask = .false.
+ if (minval(b, mask) /= all_full) call abort
+ allocate (empty(0:3,0))
+ res = minval(empty)
+ if (res /= all_full) call abort
+end program main
diff --git a/gcc/testsuite/gfortran.dg/minval_char_3.f90 b/gcc/testsuite/gfortran.dg/minval_char_3.f90
new file mode 100644
index 0000000..eea9aa6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/minval_char_3.f90
@@ -0,0 +1,69 @@
+! { dg-do run }
+program main
+ implicit none
+ integer, parameter :: n=5
+ character(len=6), dimension(n,n) :: a
+ integer, dimension(n,n) :: v
+ character(len=6), dimension(n) :: r1, r2
+ character(len=6), dimension(:,:), allocatable :: a_alloc
+ integer, dimension(:,:), allocatable :: v_alloc
+ character(len=6), parameter :: all_full = achar(255) // achar(255) // achar(255) // achar(255) // achar(255) // achar(255)
+ integer :: i
+ character(len=6),dimension(1) :: ret
+ logical, dimension(n,n) :: mask
+ logical :: smask
+
+ v = reshape([(i*i+200-17*i,i=1,n*n)],shape(v))
+ write (unit=a,fmt='(I6.6)') (i*i+200-17*i,i=1,n*n)
+
+ r1 = minval(a,dim=1)
+ write (unit=r2,fmt='(I6.6)') minval(v,dim=1)
+ if (any (r1 /= r2)) call abort
+ r1 = 'x'
+ write (unit=r1,fmt='(I6.6)') minval(v,dim=1)
+ if (any (r1 /= r2)) call abort
+
+ r1 = 'y'
+ r1 = minval(a,dim=2)
+ write (unit=r2,fmt='(I6.6)') minval(v,dim=2)
+ if (any (r1 /= r2)) call abort
+ r1 = 'z'
+ write (unit=r1,fmt='(I6.6)') minval(v,dim=2)
+ if (any (r1 /= r2)) call abort
+
+ allocate (a_alloc(0,1), v_alloc(0,1))
+ ret = 'what'
+ ret = minval(a_alloc,dim=1)
+ if (ret(1) /= all_full) call abort
+
+ r1 = 'qq'
+ r1 = minval(a, dim=1, mask=a>"000200");
+ if (any(r1 /= all_full .neqv. minval(v,dim=1, mask=v>200) < 1000)) call abort
+ if (any(minval(a, dim=1, mask=a>"000200") /= all_full .neqv. minval(v,dim=1, mask=v>200) < 1000)) call abort
+
+ r1 = 'rr'
+ r1 = minval(a, dim=2, mask=a>"000200");
+ if (any(r1 /= all_full .neqv. minval(v,dim=2, mask=v>200) < 1000)) call abort
+ if (any(minval(a, dim=2, mask=a>"000200") /= all_full .neqv. minval(v,dim=2, mask=v>200) < 1000)) call abort
+
+ mask = .true.
+ forall (i=1:n)
+ mask(i,i) = .false.
+ end forall
+
+ r1 = 'aa'
+ r1 = minval(a, dim=1, mask=mask)
+ write(unit=r2,fmt='(I6.6)') minval(v,dim=1, mask=mask)
+ if (any(r1 /= r2)) call abort
+
+ r1 = 'xyz'
+ smask = .true.
+ r1 = minval(a, dim=1, mask=smask)
+ write (unit=r2,fmt='(I6.6)') minval(v,dim=1)
+ if (any (r1 /= r2)) call abort
+
+ smask = .false.
+ r1 = 'foobar'
+ r1 = minval(a, dim=1, mask=smask)
+ if (any(r1 /= all_full)) call abort
+end program main
diff --git a/gcc/testsuite/gfortran.dg/minval_char_4.f90 b/gcc/testsuite/gfortran.dg/minval_char_4.f90
new file mode 100644
index 0000000..49176be
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/minval_char_4.f90
@@ -0,0 +1,72 @@
+! { dg-do run }
+program main
+ implicit none
+ integer, parameter :: n=5
+ character(len=6,kind=4), dimension(n,n) :: a
+ integer, dimension(n,n) :: v
+ character(len=6,kind=4), dimension(n) :: r1, r2
+ character(len=6,kind=4), dimension(:,:), allocatable :: a_alloc
+ integer, dimension(:,:), allocatable :: v_alloc
+ character(len=6,kind=4):: all_full
+ integer :: i
+ character(len=6,kind=4),dimension(1) :: ret
+ logical, dimension(n,n) :: mask
+ logical :: smask
+ integer(kind=4), dimension(6) :: kmin
+
+ kmin = -1
+ all_full = transfer(kmin,all_full)
+ v = reshape([(i*i+200-17*i,i=1,n*n)],shape(v))
+ write (unit=a,fmt='(I6.6)') (i*i+200-17*i,i=1,n*n)
+
+ r1 = minval(a,dim=1)
+ write (unit=r2,fmt='(I6.6)') minval(v,dim=1)
+ if (any (r1 /= r2)) call abort
+ r1 = 4_'x'
+ write (unit=r1,fmt='(I6.6)') minval(v,dim=1)
+ if (any (r1 /= r2)) call abort
+
+ r1 = 4_'y'
+ r1 = minval(a,dim=2)
+ write (unit=r2,fmt='(I6.6)') minval(v,dim=2)
+ if (any (r1 /= r2)) call abort
+ r1 = 4_'z'
+ write (unit=r1,fmt='(I6.6)') minval(v,dim=2)
+ if (any (r1 /= r2)) call abort
+
+ allocate (a_alloc(0,1), v_alloc(0,1))
+ ret = 4_'what'
+ ret = minval(a_alloc,dim=1)
+ if (ret(1) /= all_full) call abort
+
+ r1 = 4_'qq'
+ r1 = minval(a, dim=1, mask=a>4_"000200");
+ if (any(r1 /= all_full .neqv. minval(v,dim=1, mask=v>200) < 1000)) call abort
+ if (any(minval(a, dim=1, mask=a>4_"000200") /= all_full .neqv. minval(v,dim=1, mask=v>200) < 1000)) call abort
+
+ r1 = 4_'rr'
+ r1 = minval(a, dim=2, mask=a>4_"000200");
+ if (any(r1 /= all_full .neqv. minval(v,dim=2, mask=v>200) < 1000)) call abort
+ if (any(minval(a, dim=2, mask=a>4_"000200") /= all_full .neqv. minval(v,dim=2, mask=v>200) < 1000)) call abort
+
+ mask = .true.
+ forall (i=1:n)
+ mask(i,i) = .false.
+ end forall
+
+ r1 = 4_'aa'
+ r1 = minval(a, dim=1, mask=mask)
+ write(unit=r2,fmt='(I6.6)') minval(v,dim=1, mask=mask)
+ if (any(r1 /= r2)) call abort
+
+ r1 = 4_'xyz'
+ smask = .true.
+ r1 = minval(a, dim=1, mask=smask)
+ write (unit=r2,fmt='(I6.6)') minval(v,dim=1)
+ if (any (r1 /= r2)) call abort
+
+ smask = .false.
+ r1 = 4_'foobar'
+ r1 = minval(a, dim=1, mask=smask)
+ if (any(r1 /= all_full)) call abort
+end program main
generated by cgit v1.1 at 2025-05-23 09:57:53 +0000