re PR fortran/45689 ([F03] Missing transformational intrinsic in the trans_func_f2003 list)

2017-01-02  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/45689
	* intrinsic.c (add_function): Add gfc_simplify_maxloc and
	gfc_simplify_minloc to maxloc and minloc, respectively.
	* intrinsic.h: Add prototypes for gfc_simplify_minloc
	and gfc_simplify_maxloc.
	* simplify.c (min_max_chose): Adjust prototype.  Modify function
	to have a return value which indicates if the extremum was found.
	(is_constant_array_expr): Fix typo in comment.
	(simplify_minmaxloc_to_scalar): New function.
	(simplify_minmaxloc_nodim): New function.
	(new_array): New function.
	(simplify_minmaxloc_to_array): New function.
	(gfc_simplify_minmaxloc): New function.
	(simplify_minloc): New function.
	(simplify_maxloc): New function.

2017-01-02  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/45689
	* gfortran.dg/minloc_4.f90: New test case.
	* gfortran.dg/maxloc_4.f90: New test case.

From-SVN: r256088

gcc/fortran/ChangeLog

+2017-01-02  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/45689
+	* intrinsic.c (add_function): Add gfc_simplify_maxloc and
+	gfc_simplify_minloc to maxloc and minloc, respectively.
+	* intrinsic.h: Add prototypes for gfc_simplify_minloc
+	and gfc_simplify_maxloc.
+	* simplify.c (min_max_chose): Adjust prototype.  Modify function
+	to have a return value which indicates if the extremum was found.
+	(is_constant_array_expr): Fix typo in comment.
+	(simplify_minmaxloc_to_scalar): New function.
+	(simplify_minmaxloc_nodim): New function.
+	(new_array): New function.
+	(simplify_minmaxloc_to_array): New function.
+	(gfc_simplify_minmaxloc): New function.
+	(simplify_minloc): New function.
+	(simplify_maxloc): New function.
+
 2018-01-02  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
 	PR fortran/45689

gcc/fortran/intrinsic.c

@@ -2458,7 +2458,7 @@ add_functions (void)
   make_generic ("maxexponent", GFC_ISYM_MAXEXPONENT, GFC_STD_F95);
 
   add_sym_4ml ("maxloc", GFC_ISYM_MAXLOC, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
-	       gfc_check_minloc_maxloc, NULL, gfc_resolve_maxloc,
+	       gfc_check_minloc_maxloc, gfc_simplify_maxloc, gfc_resolve_maxloc,
 	       ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
 	       msk, BT_LOGICAL, dl, OPTIONAL, kind, BT_INTEGER, di, OPTIONAL);
 
@@ -2534,7 +2534,7 @@ add_functions (void)
   make_generic ("minexponent", GFC_ISYM_MINEXPONENT, GFC_STD_F95);
 
   add_sym_4ml ("minloc", GFC_ISYM_MINLOC, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
-	       gfc_check_minloc_maxloc, NULL, gfc_resolve_minloc,
+	       gfc_check_minloc_maxloc, gfc_simplify_minloc, gfc_resolve_minloc,
 	       ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
 	       msk, BT_LOGICAL, dl, OPTIONAL, kind, BT_INTEGER, di, OPTIONAL);
 

gcc/fortran/intrinsic.h

@@ -347,8 +347,10 @@ gfc_expr *gfc_simplify_maskr (gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_merge (gfc_expr *, gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_merge_bits (gfc_expr *, gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_min (gfc_expr *);
+gfc_expr *gfc_simplify_minloc (gfc_expr*, gfc_expr *, gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_minval (gfc_expr *, gfc_expr*, gfc_expr*);
 gfc_expr *gfc_simplify_max (gfc_expr *);
+gfc_expr *gfc_simplify_maxloc (gfc_expr*, gfc_expr *, gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_maxval (gfc_expr *, gfc_expr*, gfc_expr*);
 gfc_expr *gfc_simplify_maxexponent (gfc_expr *);
 gfc_expr *gfc_simplify_minexponent (gfc_expr *);

gcc/testsuite/gfortran.dg/maxloc_4.f90

+! { dg-do  run }
+! Check that simplification of maxloc works
+program main
+  implicit none
+  integer :: d
+  real, dimension(2), parameter :: a = [1.0, 0.0]
+  character(len=3), dimension(3), parameter :: c = [ "fgh", "asd", "jkl" ]
+  integer, parameter :: b = maxloc(a,dim=1)
+  integer, parameter :: b2 = maxloc(a,dim=1,mask=[.false.,.false.])
+  integer, parameter :: b3 = maxloc(c,dim=1)
+  integer, parameter :: b4 = maxloc(c,dim=1,mask=[c<"iii"])
+  integer, parameter,dimension(2,2) :: i1 = reshape([4,5,3,2],shape(i1))
+  integer, parameter, dimension(2) :: b5 = maxloc(i1)
+  integer, parameter, dimension(2) :: b6 = maxloc(i1,mask=i1>7)
+  integer, parameter, dimension(2) :: b7 = maxloc(i1, mask=i1<5)
+  integer, parameter, dimension(2) :: b8 = maxloc(i1, mask=.true.)
+  integer, parameter, dimension(2) :: b9 = maxloc(i1, mask=.false.)
+  integer, parameter, dimension(2,3) :: i2 = &
+       reshape([2, -1, -3, 4, -5, 6], shape(i2))
+  integer, parameter, dimension(3) :: b10 = maxloc(i2, dim=1)
+  integer, parameter, dimension(2) :: b11 = maxloc(i2, dim=2)
+  integer, parameter, dimension(3) :: b12 = maxloc(i2,dim=1,mask=i2<0)
+  integer, parameter, dimension(2) :: b13 = maxloc(i2,dim=2, mask=i2<-10)
+  if (b /= 1) call abort
+  if (b2 /= 0) call abort
+  if (b3 /= 3) call abort
+  if (b4 /= 1) call abort
+  if (any(b5 /= [2,1])) call abort
+  if (any(b6 /= [0, 0])) call abort
+  if (any(b7 /= [1,1])) call abort
+  if (any(b8 /= b5)) call abort
+  if (any(b9 /= [0, 0])) call abort
+  d = 1
+  if (any(b10 /= maxloc(i2,dim=d))) call abort
+  d = 2
+  if (any(b11 /= maxloc(i2,dim=2))) call abort
+  d = 1
+  if (any(b12 /= maxloc(i2, dim=d,mask=i2<0))) call abort
+  if (any(b13 /= 0)) call abort
+end program main

gcc/testsuite/gfortran.dg/minloc_4.f90

+! { dg-do  run }
+! Check that simplification of minloc works
+program main
+  implicit none
+  integer :: d
+  real, dimension(2), parameter :: a = [1.0, 0.0]
+  character(len=3), dimension(3), parameter :: c = [ "fgh", "asd", "jkl" ]
+  integer, parameter :: b = minloc(a,dim=1)
+  integer, parameter :: b2 = minloc(a,dim=1,mask=[.false.,.false.])
+  integer, parameter :: b3 = minloc(c,dim=1)
+  integer, parameter :: b4 = minloc(c,dim=1,mask=[c>"bbb"])
+  integer, parameter,dimension(2,2) :: i1 = reshape([4,3,2,5],shape(i1))
+  integer, parameter, dimension(2) :: b5 = minloc(i1)
+  integer, parameter, dimension(2) :: b6 = minloc(i1,mask=i1>7)
+  integer, parameter, dimension(2) :: b7 = minloc(i1, mask=i1>2)
+  integer, parameter, dimension(2) :: b8 = minloc(i1, mask=.true.)
+  integer, parameter, dimension(2) :: b9 = minloc(i1, mask=.false.)
+  integer, parameter, dimension(2,3) :: i2 = &
+       reshape([2, -1, -3, 4, -5, 6], shape(i2))
+  integer, parameter, dimension(3) :: b10 = minloc(i2, dim=1)
+  integer, parameter, dimension(2) :: b11 = minloc(i2, dim=2)
+  integer, parameter, dimension(3) :: b12 = minloc(i2,dim=1,mask=i2>3)
+  integer, parameter, dimension(2) :: b13 = minloc(i2,dim=2, mask=i2<-10)
+  if (b /= 2) call abort
+  if (b2 /= 0) call abort
+  if (b3 /= 2) call abort
+  if (b4 /= 1) call abort
+  if (any(b5 /= [1, 2])) call abort
+  if (any(b6 /= [0, 0])) call abort
+  if (any(b7 /= [2, 1])) call abort
+  if (any(b8 /= [1, 2])) call abort
+  if (any(b9 /= [0, 0])) call abort
+  d = 1
+  if (any(b10 /= minloc(i2,dim=d))) call abort
+  d = 2
+  if (any(b11 /= minloc(i2,dim=2))) call abort
+  d = 1
+  if (any(b12 /= minloc(i2, dim=d,mask=i2>3))) call abort
+  if (any(b13 /= 0)) call abort
+end program main