This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[Patch, fortran] PR25378 - [Fortran 2003] maxloc for all-false mask


:ADDPATCH fortran:

This patch replaces the F95 processor dependent result for min/maxloc, in the event where the masks are all false, with the F2003 requirement that the result is zero. Previously, gfortran returned 1. Either is acceptable for F95 so it seems as well to implement Thomas Koenig's suggestion. This is also consistent with commercial compilers.

The logic is:

set initial index = 0                             /* was 1 */
if (the max/min condition is met or index = 0)    /* rhs of or has been added */
 {
    set index to the current position
    update the value for comparison
 }


I have modified and extended the existing testcases and see no reason to add any more.


Regtested on FC3/Athlon. OK for 4.1 and 4.2?

Paul

2006-03-09 Paul Thomas <pault@gcc.gnu.org>

PR fortran/25378
* trans-intrinsic.c (gfc_conv_intrinsic_minmaxloc): Set the initial position to zero and
modify the condition for updating it, to implement the F2003 requirement for all(mask)
is false.


2006-03-09 Paul Thomas <pault@gcc.gnu.org>

PR fortran/25378
* libgfortran/m4/minloc1.m4: Set the initial position to zero and modify the condition for
updating it, to implement the F2003 requirement for all(mask).eq.false.
* libgfortran/m4/maxloc1.m4: The same.
* libgfortran/m4/iforeach.m4: The same.
* libgfortran/m4/minloc0.m4: The same.
* libgfortran/m4/maxloc0.m4: The same.
* libgfortran/generated/maxloc0_16_i16.c: Regenerated, together with 41 others.
* libgfortran/generated/minloc0_16_i16.c: Regenerated, together with 41 others.


2006-03-09 Paul Thomas <pault@gcc.gnu.org>

PR fortran/25378
* gfortran.fortran-torture/execute/intrinsic_mmloc_3.f90: Expand test to include more
permuatations of mask and index.
* testsuite/gfortran.dg/scalar_mask_1.f90: Modify last test to respond to F2003 spec.
that the position returned for an all false mask && condition is zero.


PS I can list all 84 permutations of min/maxloc, if necessary but cannot see the value of it.


Index: gcc/fortran/trans-intrinsic.c
===================================================================
*** gcc/fortran/trans-intrinsic.c	(revision 111793)
--- gcc/fortran/trans-intrinsic.c	(working copy)
*************** gfc_conv_intrinsic_minmaxloc (gfc_se * s
*** 1671,1677 ****
    tree tmp;
    tree elsetmp;
    tree ifbody;
-   tree cond;
    gfc_loopinfo loop;
    gfc_actual_arglist *actual;
    gfc_ss *arrayss;
--- 1671,1676 ----
*************** gfc_conv_intrinsic_minmaxloc (gfc_se * s
*** 1744,1760 ****
  
    gcc_assert (loop.dimen == 1);
  
!   /* Initialize the position to the first element.  If the array has zero
!      size we need to return zero.  Otherwise use the first element of the
!      array, in case all elements are equal to the limit.
!      i.e. pos = (ubound >= lbound) ? lbound, lbound - 1;  */
!   tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type,
! 		     loop.from[0], gfc_index_one_node);
!   cond = fold_build2 (GE_EXPR, boolean_type_node,
! 		      loop.to[0], loop.from[0]);
!   tmp = fold_build3 (COND_EXPR, gfc_array_index_type, cond,
! 		     loop.from[0], tmp);
!   gfc_add_modify_expr (&loop.pre, pos, tmp);
  
    gfc_mark_ss_chain_used (arrayss, 1);
    if (maskss)
--- 1743,1752 ----
  
    gcc_assert (loop.dimen == 1);
  
!   /* Initialize the position to zero, following Fortran 2003.  We are free
!      to do this because Fortran 95 allows the result of an entirely false
!      mask to be processor dependent.  */
!   gfc_add_modify_expr (&loop.pre, pos, gfc_index_zero_node);
  
    gfc_mark_ss_chain_used (arrayss, 1);
    if (maskss)
*************** gfc_conv_intrinsic_minmaxloc (gfc_se * s
*** 1794,1801 ****
  
    ifbody = gfc_finish_block (&ifblock);
  
!   /* If it is a more extreme value.  */
!   tmp = build2 (op, boolean_type_node, arrayse.expr, limit);
    tmp = build3_v (COND_EXPR, tmp, ifbody, build_empty_stmt ());
    gfc_add_expr_to_block (&block, tmp);
  
--- 1786,1795 ----
  
    ifbody = gfc_finish_block (&ifblock);
  
!   /* If it is a more extreme value or pos is still zero.  */
!   tmp = build2 (TRUTH_OR_EXPR, boolean_type_node,
! 		  build2 (op, boolean_type_node, arrayse.expr, limit),
! 		  build2 (EQ_EXPR, boolean_type_node, pos, gfc_index_zero_node));
    tmp = build3_v (COND_EXPR, tmp, ifbody, build_empty_stmt ());
    gfc_add_expr_to_block (&block, tmp);
  
*************** gfc_conv_intrinsic_minmaxloc (gfc_se * s
*** 1826,1839 ****
  	 the pos variable the same way as above.  */
  
        gfc_init_block (&elseblock);
! 
!       elsetmp = fold_build2 (MINUS_EXPR, gfc_array_index_type,
! 			     loop.from[0], gfc_index_one_node);
!       cond = fold_build2 (GE_EXPR, boolean_type_node,
! 			  loop.to[0], loop.from[0]);
!       elsetmp = fold_build3 (COND_EXPR, gfc_array_index_type, cond,
! 			  loop.from[0], elsetmp);
!       gfc_add_modify_expr (&elseblock, pos, elsetmp);
        elsetmp = gfc_finish_block (&elseblock);
  
        tmp = build3_v (COND_EXPR, maskse.expr, tmp, elsetmp);
--- 1820,1826 ----
  	 the pos variable the same way as above.  */
  
        gfc_init_block (&elseblock);
!       gfc_add_modify_expr (&elseblock, pos, gfc_index_zero_node);
        elsetmp = gfc_finish_block (&elseblock);
  
        tmp = build3_v (COND_EXPR, maskse.expr, tmp, elsetmp);
Index: libgfortran/m4/minloc1.m4
===================================================================
*** libgfortran/m4/minloc1.m4	(revision 111792)
--- libgfortran/m4/minloc1.m4	(working copy)
*************** include(ifunction.m4)dnl
*** 43,50 ****
  ARRAY_FUNCTION(0,
  `  atype_name minval;
    minval = atype_max;
!   result = 1;',
! `  if (*src < minval)
      {
        minval = *src;
        result = (rtype_name)n + 1;
--- 43,50 ----
  ARRAY_FUNCTION(0,
  `  atype_name minval;
    minval = atype_max;
!   result = 0;',
! `  if (*src < minval || !result)
      {
        minval = *src;
        result = (rtype_name)n + 1;
*************** ARRAY_FUNCTION(0,
*** 53,60 ****
  MASKED_ARRAY_FUNCTION(0,
  `  atype_name minval;
    minval = atype_max;
!   result = 1;',
! `  if (*msrc && *src < minval)
      {
        minval = *src;
        result = (rtype_name)n + 1;
--- 53,60 ----
  MASKED_ARRAY_FUNCTION(0,
  `  atype_name minval;
    minval = atype_max;
!   result = 0;',
! `  if (*msrc && (*src < minval || !result))
      {
        minval = *src;
        result = (rtype_name)n + 1;
Index: libgfortran/m4/maxloc1.m4
===================================================================
*** libgfortran/m4/maxloc1.m4	(revision 111792)
--- libgfortran/m4/maxloc1.m4	(working copy)
*************** include(ifunction.m4)dnl
*** 43,50 ****
  ARRAY_FUNCTION(0,
  `  atype_name maxval;
    maxval = atype_min;
!   result = 1;',
! `  if (*src > maxval)
      {
        maxval = *src;
        result = (rtype_name)n + 1;
--- 43,50 ----
  ARRAY_FUNCTION(0,
  `  atype_name maxval;
    maxval = atype_min;
!   result = 0;',
! `  if (*src > maxval || !result)
      {
        maxval = *src;
        result = (rtype_name)n + 1;
*************** ARRAY_FUNCTION(0,
*** 53,60 ****
  MASKED_ARRAY_FUNCTION(0,
  `  atype_name maxval;
    maxval = atype_min;
!   result = 1;',
! `  if (*msrc && *src > maxval)
      {
        maxval = *src;
        result = (rtype_name)n + 1;
--- 53,60 ----
  MASKED_ARRAY_FUNCTION(0,
  `  atype_name maxval;
    maxval = atype_min;
!   result = 0;',
! `  if (*msrc && (*src > maxval || !result))
      {
        maxval = *src;
        result = (rtype_name)n + 1;
Index: libgfortran/m4/iforeach.m4
===================================================================
*** libgfortran/m4/iforeach.m4	(revision 111792)
--- libgfortran/m4/iforeach.m4	(working copy)
*************** name`'rtype_qual`_'atype_code (rtype * c
*** 71,77 ****
  
    /* Initialize the return value.  */
    for (n = 0; n < rank; n++)
!     dest[n * dstride] = 1;
    {
  ')dnl
  define(START_FOREACH_BLOCK,
--- 71,77 ----
  
    /* Initialize the return value.  */
    for (n = 0; n < rank; n++)
!     dest[n * dstride] = 0;
    {
  ')dnl
  define(START_FOREACH_BLOCK,
*************** void
*** 198,204 ****
  
    /* Initialize the return value.  */
    for (n = 0; n < rank; n++)
!     dest[n * dstride] = 1;
    {
  ')dnl
  define(START_MASKED_FOREACH_BLOCK, `START_FOREACH_BLOCK')dnl
--- 198,204 ----
  
    /* Initialize the return value.  */
    for (n = 0; n < rank; n++)
!     dest[n * dstride] = 0;
    {
  ')dnl
  define(START_MASKED_FOREACH_BLOCK, `START_FOREACH_BLOCK')dnl
Index: libgfortran/m4/minloc0.m4
===================================================================
*** libgfortran/m4/minloc0.m4	(revision 111792)
--- libgfortran/m4/minloc0.m4	(working copy)
*************** FOREACH_FUNCTION(
*** 45,51 ****
  
    minval = atype_max;'
  ,
! `  if (*base < minval)
      {
        minval = *base;
        for (n = 0; n < rank; n++)
--- 45,51 ----
  
    minval = atype_max;'
  ,
! `  if (*base < minval || !dest[0])
      {
        minval = *base;
        for (n = 0; n < rank; n++)
*************** MASKED_FOREACH_FUNCTION(
*** 57,63 ****
  
    minval = atype_max;'
  ,
! `  if (*mbase && *base < minval)
      {
        minval = *base;
        for (n = 0; n < rank; n++)
--- 57,63 ----
  
    minval = atype_max;'
  ,
! `  if (*mbase && (*base < minval || !dest[0]))
      {
        minval = *base;
        for (n = 0; n < rank; n++)
Index: libgfortran/m4/maxloc0.m4
===================================================================
*** libgfortran/m4/maxloc0.m4	(revision 111792)
--- libgfortran/m4/maxloc0.m4	(working copy)
*************** FOREACH_FUNCTION(
*** 45,51 ****
  
    maxval = atype_min;'
  ,
! `  if (*base > maxval)
      {
        maxval = *base;
        for (n = 0; n < rank; n++)
--- 45,51 ----
  
    maxval = atype_min;'
  ,
! `  if (*base > maxval || !dest[0])
      {
        maxval = *base;
        for (n = 0; n < rank; n++)
*************** MASKED_FOREACH_FUNCTION(
*** 57,63 ****
  
    maxval = atype_min;'
  ,
! `  if (*mbase && *base > maxval)
      {
        maxval = *base;
        for (n = 0; n < rank; n++)
--- 57,63 ----
  
    maxval = atype_min;'
  ,
! `  if (*mbase && (*base > maxval || !dest[0]))
      {
        maxval = *base;
        for (n = 0; n < rank; n++)
Index: gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_mmloc_3.f90
===================================================================
*** gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_mmloc_3.f90	(revision 111792)
--- gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_mmloc_3.f90	(working copy)
***************
*** 3,12 ****
  program intrinsic_mmloc_3
    integer, dimension(2) :: d
    integer, dimension(2,2) :: a
  
    d = -huge (d)
!   if (maxloc (d, 1) .ne. 1) call abort()
    a = huge (a)
    d = minloc (a)
!   if (any (d .ne. 1)) call abort()
  end program
--- 3,40 ----
  program intrinsic_mmloc_3
    integer, dimension(2) :: d
    integer, dimension(2,2) :: a
+   logical, dimension(2) :: k
+   logical, dimension(2,2) :: l
+ 
+   k = .true.
+   l = .true.
+ 
+   d = -huge (d)
+   if (maxloc (d, 1) .ne. 1) call abort ()
+ 
+   d = huge (d)
+   if (minloc (d, 1) .ne. 1) call abort ()
  
    d = -huge (d)
!   if (maxloc (d, 1, k) .ne. 1) call abort ()
! 
!   d = huge (d)
!   if (minloc (d, 1, k) .ne. 1) call abort ()
! 
!   a = -huge (a)
!   d = maxloc (a)
!   if (any (d .ne. 1)) call abort ()
! 
    a = huge (a)
    d = minloc (a)
!   if (any (d .ne. 1)) call abort ()
! 
!   a = -huge (a)
!   d = maxloc (a, l)
!   if (any (d .ne. 1)) call abort ()
! 
!   a = huge (a)
!   d = minloc (a, l)
!   if (any (d .ne. 1)) call abort ()
! 
  end program
Index: gcc/testsuite/gfortran.dg/scalar_mask_1.f90
===================================================================
*** gcc/testsuite/gfortran.dg/scalar_mask_1.f90	(revision 111792)
--- gcc/testsuite/gfortran.dg/scalar_mask_1.f90	(working copy)
*************** program main
*** 11,15 ****
    if (maxval (a, .true.) /= 3.0) call abort
    if (maxval (a, .false.) > -1e38) call abort
    if (maxloc (a, 1, .true.) /= 2) call abort
!   if (maxloc (a, 1, .false.) /= 1) call abort
  end program main
--- 11,15 ----
    if (maxval (a, .true.) /= 3.0) call abort
    if (maxval (a, .false.) > -1e38) call abort
    if (maxloc (a, 1, .true.) /= 2) call abort
!   if (maxloc (a, 1, .false.) /= 0) call abort ! Change to F2003 requirement.
  end program main

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]