diff mbox

PR fortran/50573 -- Fix checking of dshift{lr} arguments

Message ID 20111030220235.GA40305@troutmask.apl.washington.edu
State New
Headers show

Commit Message

Steve Kargl Oct. 30, 2011, 10:02 p.m. UTC 
On Fri, Oct 28, 2011 at 07:43:58AM +0200, Tobias Burnus wrote:
> Am 28.10.2011 01:27, schrieb Steve Kargl:
> >The attached patch tightens the checking of the arguments
> >of the dshiftl and dshiftr argument.  It also does a kind
> >type conversion when either I or J is a BOZ to the kind
> >type of the non-BOZ I or J.
> >
> >OK for trunk?
> 
> OK with a changelog entry for the NEAREST change. And thanks for the patch.
> 
> Could you also update the manual?
> http://gcc.gnu.org/onlinedocs/gfortran/DSHIFTL.html
> 

Here's the patch I committed.  The NEAREST stuff was committed 
in a prevous commit, and I've updated the docs.


2011-10-30  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/50573
	* check.c (gfc_check_dshift): Update argument checking for BOZ.
	Update checking SHIFT against BITSIZE of I or J.
	* intrinsic.texi: Update docs for DSHIFTL and DSHIFTR.

2011-10-30  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/50573
	* gfortran.dg/dshift_3.f90: New test.
diff mbox

Patch

Index: fortran/check.c
===================================================================
--- fortran/check.c	(revision 180622)
+++ fortran/check.c	(working copy)
@@ -1483,7 +1483,14 @@  gfc_check_dshift (gfc_expr *i, gfc_expr 
   if (type_check (j, 1, BT_INTEGER) == FAILURE)
     return FAILURE;
 
-  if (same_type_check (i, 0, j, 1) == FAILURE)
+  if (i->is_boz && j->is_boz)
+    {
+      gfc_error ("'I' at %L and 'J' at %L cannot both be BOZ literal "
+		 "constants", &i->where, &j->where);
+      return FAILURE;
+    }
+
+  if (!i->is_boz && !j->is_boz && same_type_check (i, 0, j, 1) == FAILURE)
     return FAILURE;
 
   if (type_check (shift, 2, BT_INTEGER) == FAILURE)
@@ -1492,8 +1499,18 @@  gfc_check_dshift (gfc_expr *i, gfc_expr 
   if (nonnegative_check ("SHIFT", shift) == FAILURE)
     return FAILURE;
 
-  if (less_than_bitsize1 ("I", i, "SHIFT", shift, true) == FAILURE)
-    return FAILURE;
+  if (i->is_boz)
+    {
+      if (less_than_bitsize1 ("J", j, "SHIFT", shift, true) == FAILURE)
+    	return FAILURE;
+      i->ts.kind = j->ts.kind;
+    }
+  else
+    {
+      if (less_than_bitsize1 ("I", i, "SHIFT", shift, true) == FAILURE)
+    	return FAILURE;
+      j->ts.kind = i->ts.kind;
+    }
 
   return SUCCESS;
 }
Index: fortran/intrinsic.texi
===================================================================
--- fortran/intrinsic.texi	(revision 180622)
+++ fortran/intrinsic.texi	(working copy)
@@ -3794,22 +3794,27 @@  Elemental function
 
 @item @emph{Arguments}:
 @multitable @columnfractions .15 .70
-@item @var{I} @tab Shall be of type @code{INTEGER}.
-@item @var{J} @tab Shall be of type @code{INTEGER}, and of the same kind
-as @var{I}.
-@item @var{SHIFT} @tab Shall be of type @code{INTEGER}.
+@item @var{I} @tab Shall be of type @code{INTEGER} or a BOZ constant.
+@item @var{J} @tab Shall be of type @code{INTEGER} or a BOZ constant.
+If both @var{I} and @var{J} have integer type, then they shall have
+the same kind type parameter. @var{I} and @var{J} shall not both be
+BOZ constants.
+@item @var{SHIFT} @tab Shall be of type @code{INTEGER}. It shall
+be nonnegative.  If @var{I} is not a BOZ constant, then @var{SHIFT}
+shall be less than or equal to @code{BIT_SIZE(I)}; otherwise,
+@var{SHIFT} shall be less than or equal to @code{BIT_SIZE(J)}.
 @end multitable
 
 @item @emph{Return value}:
-The return value has same type and kind as @var{I}.
+If either @var{I} or @var{J} is a BOZ constant, it is first converted
+as if by the intrinsic function @code{INT} to an integer type with the
+kind type parameter of the other.
 
 @item @emph{See also}:
 @ref{DSHIFTR}
-
 @end table
 
 
-
 @node DSHIFTR
 @section @code{DSHIFTR} --- Combined right shift
 @fnindex DSHIFTR
@@ -3834,22 +3839,27 @@  Elemental function
 
 @item @emph{Arguments}:
 @multitable @columnfractions .15 .70
-@item @var{I} @tab Shall be of type @code{INTEGER}.
-@item @var{J} @tab Shall be of type @code{INTEGER}, and of the same kind
-as @var{I}.
-@item @var{SHIFT} @tab Shall be of type @code{INTEGER}.
+@item @var{I} @tab Shall be of type @code{INTEGER} or a BOZ constant.
+@item @var{J} @tab Shall be of type @code{INTEGER} or a BOZ constant.
+If both @var{I} and @var{J} have integer type, then they shall have
+the same kind type parameter. @var{I} and @var{J} shall not both be
+BOZ constants.
+@item @var{SHIFT} @tab Shall be of type @code{INTEGER}. It shall
+be nonnegative.  If @var{I} is not a BOZ constant, then @var{SHIFT}
+shall be less than or equal to @code{BIT_SIZE(I)}; otherwise,
+@var{SHIFT} shall be less than or equal to @code{BIT_SIZE(J)}.
 @end multitable
 
 @item @emph{Return value}:
-The return value has same type and kind as @var{I}.
+If either @var{I} or @var{J} is a BOZ constant, it is first converted
+as if by the intrinsic function @code{INT} to an integer type with the
+kind type parameter of the other.
 
 @item @emph{See also}:
 @ref{DSHIFTL}
-
 @end table
 
 
-
 @node DTIME
 @section @code{DTIME} --- Execution time subroutine (or function)
 @fnindex DTIME
Index: testsuite/gfortran.dg/dshift_3.f90
===================================================================
--- testsuite/gfortran.dg/dshift_3.f90	(revision 0)
+++ testsuite/gfortran.dg/dshift_3.f90	(revision 0)
@@ -0,0 +1,34 @@ 
+! { dg-do compile }
+! PR fortran/50753
+subroutine foo(i, j, k)
+
+   implicit none
+
+   integer(4), intent(in) :: i, j
+   integer(8), intent(in) :: k
+
+   print *, dshiftl(i,      j, 134)     ! { dg-error "must be less than or equal" }
+   print *, dshiftl(z'FFF', j, 134)     ! { dg-error "must be less than or equal" }
+   print *, dshiftl(i, j, -10)          ! { dg-error "must be nonnegative" }
+   print *, dshiftl(z'FFF', z'EEE', 10) ! { dg-error "cannot both be" }
+   print *, dshiftl(z'FFF', j, 10)
+   print *, dshiftl(i, z'EEE', 10)
+   print *, dshiftl(i, j, 10)
+   print *, dshiftl(i, k, 10)           ! { dg-error "must be the same type and kind" }
+   print *, dshiftl(k, j, 10)           ! { dg-error "must be the same type and kind" }
+   print *, dshiftl(i, j, k)
+   print *, dshiftl(i, j, z'd')
+
+   print *, dshiftr(i,      j, 134)     ! { dg-error "must be less than or equal" }
+   print *, dshiftr(z'FFF', j, 134)     ! { dg-error "must be less than or equal" }
+   print *, dshiftr(i, j, -10)          ! { dg-error "must be nonnegative" }
+   print *, dshiftr(z'FFF', z'EEE', 10) ! { dg-error "cannot both be" }
+   print *, dshiftr(z'FFF', j, 10)
+   print *, dshiftr(i, z'EEE', 10)
+   print *, dshiftr(i, j, 10)
+   print *, dshiftr(i, k, 10)           ! { dg-error "must be the same type and kind" }
+   print *, dshiftr(k, j, 10)           ! { dg-error "must be the same type and kind" }
+   print *, dshiftr(i, j, k)
+   print *, dshiftr(i, j, z'd')
+
+end subroutine foo