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]

Re: [PATCH] fortran/50514 -- Fix static chekcing of ISHFT[C] arguments.


On 10/15/2011 11:21 PM, Steve Kargl wrote:
OK for trunk?

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

* gfortran.dg/ishft_3.f90: Update test.

I am not so happy with complete test replacements. How about adding it as new test case?



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

	* check.c (less_than_bitsize1): Check|shift|  <= bit_size(i).
	(gfc_check_ishftc):  Check|shift|  <= bit_size(i) and check
	that size is positive.

I somehow find less_than_bitsize1's


+ if (strncmp (arg2, "ISHFT", 5) == 0)

not that elegant and would prefer another argument, which tells the function that it should take the absolute value of the argument; however, given that ISHFT seems to be the only function which allows negative arguments, one could also leave it.

OK with considering the two remarks. Thanks for the patch!

Tobias

PS: As you have probably seen, I found a related issue regarding DSHIFTL/DSHIFTR: PR 50753.

Index: testsuite/gfortran.dg/ishft_3.f90
===================================================================
--- testsuite/gfortran.dg/ishft_3.f90	(revision 179208)
+++ testsuite/gfortran.dg/ishft_3.f90	(working copy)
@@ -1,11 +1,38 @@
  ! { dg-do compile }
+! PR fortran/50514
  program ishft_3
-  integer i, j
-  write(*,*) ishftc( 3, 2, 3 )
-  write(*,*) ishftc( 3, 2, i )
-  write(*,*) ishftc( 3, i, j )
-  write(*,*) ishftc( 3, 128 )     ! { dg-error "exceeds BIT_SIZE of first" }
-  write(*,*) ishftc( 3, 0, 128 )  ! { dg-error "exceeds BIT_SIZE of first" }
-  write(*,*) ishftc( 3, 0, 0 )    ! { dg-error "Invalid third argument" }
-  write(*,*) ishftc( 3, 3, 2 )    ! { dg-error "exceeds third argument" }
+
+   implicit none
+
+   integer j, m
+
+   m = 42
+   !
+   ! These should compile.
+   !
+   j = ishft(m, 16)
+   j = ishft(m, -16)
+   j = ishftc(m, 16)
+   j = ishftc(m, -16)
+   !
+   ! These should issue an error.
+   !
+   j = ishft(m, 640)    ! { dg-error "absolute value of SHIFT" }
+   j = ishftc(m, 640)   ! { dg-error "absolute value of SHIFT" }
+   j = ishft(m, -640)   ! { dg-error "absolute value of SHIFT" }
+   j = ishftc(m, -640)  ! { dg-error "absolute value of SHIFT" }
+
+   ! abs(SHIFT) must be<= SIZE
+
+   j = ishftc(m,  1, 2)
+   j = ishftc(m,  1, 2)
+   j = ishftc(m, -1, 2)
+   j = ishftc(m, -1, 2)
+
+   j = ishftc(m,  10, 2)! { dg-error "absolute value of SHIFT" }
+   j = ishftc(m,  10, 2)! { dg-error "absolute value of SHIFT" }
+   j = ishftc(m, -10, 2)! { dg-error "absolute value of SHIFT" }
+   j = ishftc(m, -10, 2)! { dg-error "absolute value of SHIFT" }
+
+   j = ishftc(m, 1, -2) ! { dg-error "must be positive" }
  end program

Index: fortran/check.c
===================================================================
--- fortran/check.c	(revision 179208)
+++ fortran/check.c	(working copy)
@@ -318,6 +318,22 @@ less_than_bitsize1 (const char *arg1, gf
      {
        gfc_extract_int (expr2,&i2);
        i3 = gfc_validate_kind (BT_INTEGER, expr1->ts.kind, false);
+
+      /* For ISHFT[C],|shift|  <= bit_size(i).  */
+      if (strncmp (arg2, "ISHFT", 5) == 0)
+	{
+	  if (i2<  0)
+	    i2 = -i2;
+
+	  if (i2>  gfc_integer_kinds[i3].bit_size)
+	    {
+	      gfc_error ("The absolute value of SHIFT at %L must be less "
+			 "than or equal to BIT_SIZE('%s')",
+			&expr2->where, arg1);
+	      return FAILURE;
+	    }
+	}
+
        if (or_equal)
  	{
  	  if (i2>  gfc_integer_kinds[i3].bit_size)
@@ -1961,6 +1977,9 @@ gfc_check_ishft (gfc_expr *i, gfc_expr *
        || type_check (shift, 1, BT_INTEGER) == FAILURE)
      return FAILURE;

+  if (less_than_bitsize1 ("I", i, "ISHFT", shift, true) == FAILURE)
+    return FAILURE;
+
    return SUCCESS;
  }

@@ -1972,7 +1991,35 @@ gfc_check_ishftc (gfc_expr *i, gfc_expr
        || type_check (shift, 1, BT_INTEGER) == FAILURE)
      return FAILURE;

-  if (size != NULL&&  type_check (size, 2, BT_INTEGER) == FAILURE)
+  if (size != NULL)
+    {
+      int i2, i3;
+
+      if (type_check (size, 2, BT_INTEGER) == FAILURE)
+	return FAILURE;
+
+      if (less_than_bitsize1 ("I", i, "SIZE", size, true) == FAILURE)
+	return FAILURE;
+
+      gfc_extract_int (size,&i3);
+      if (i3<= 0)
+	{
+	  gfc_error ("SIZE at %L must be positive",&size->where);
+	  return FAILURE;
+	}
+
+      gfc_extract_int (shift,&i2);
+      if (i2<  0)
+	i2 = -i2;
+
+      if (i2>  i3)
+	{
+	  gfc_error ("The absolute value of SHIFT at %L must be less than "
+		     "or equal to SIZE at %L",&shift->where,&size->where);
+	  return FAILURE;
+	}
+    }
+  else if (less_than_bitsize1 ("I", i, "ISHFTC", shift, true) == FAILURE)
      return FAILURE;

return SUCCESS;


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