diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index fb3e52bbbbf9fedbbe4d10571f4a022d1907bdc2..40d2a304bd56b8e984e7a9b9ed81761486d2387e 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+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-28 Steven G. Kargl <kargl@gcc.gnu.org>
* check.c (gfc_check_atan_2): Typo in comment.
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 0f54ccd4b632a2b97d7ea00500cb708228e7d98b..d9b9a9cd580031174793db7eacf683cc28c16099 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -1483,7 +1483,14 @@ gfc_check_dshift (gfc_expr *i, gfc_expr *j, gfc_expr *shift)
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 *j, gfc_expr *shift)
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;
}
diff --git a/gcc/fortran/intrinsic.texi b/gcc/fortran/intrinsic.texi
index 084cd15ea6f4931d3c2d8d47532c9aa38cddece3..24af4d5ac7d5510bd131dd0050eeef136e685ec7 100644
--- a/gcc/fortran/intrinsic.texi
+++ b/gcc/fortran/intrinsic.texi
@@ -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
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index b1088ace33dd2bd84f521f6d56c032bb39a8ed2c..0828817cee53763ece222dc902cd1850bd942423 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2011-10-30 Steven G. Kargl <kargl@gcc.gnu.org>
+
+ PR fortran/50753
+ * gfortran.dg/dshift_3.f90: New test.
+
2011-10-30 John David Anglin <dave.anglin@nrc-cnrc.gc.ca>
* gcc.dg/scal-to-vec2.c (dg-options): Add -fno-common to options on
diff --git a/gcc/testsuite/gfortran.dg/dshift_3.f90 b/gcc/testsuite/gfortran.dg/dshift_3.f90
new file mode 100644
index 0000000000000000000000000000000000000000..1f214c7d1c76cff314a7fa38c38a845d2482fd31
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dshift_3.f90
@@ -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