This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[PATCH] PR fortran/44346 -- check some values in ibits, mvbits
- From: Steve Kargl <sgk at troutmask dot apl dot washington dot edu>
- To: fortran at gcc dot gnu dot org, gcc-patches at gcc dot gnu dot org
- Date: Mon, 31 May 2010 13:34:31 -0700
- Subject: [PATCH] PR fortran/44346 -- check some values in ibits, mvbits
The attached patch was tested on i686-*-freebsd. The patch with
the testcases are obvious (to at least me).
OK for trunk (and 4.5 after testing)?.
2010-05-31 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/44346
* fortran/check.c (gfc_check_ibits, gfc_check_mvbits): Add checks that
constant argument(s) are within range.
2010-05-31 Steven G. Kargl <kargl@gcc.gnu.org>
* testsuite/gfortran.dg/ibits_1.f90: New test.
* testsuite/gfortran.dg/mvbits_9.f90: New test.
--
Steve
Index: fortran/check.c
===================================================================
--- fortran/check.c (revision 160081)
+++ fortran/check.c (working copy)
@@ -1413,6 +1413,43 @@ gfc_check_ibits (gfc_expr *i, gfc_expr *
if (type_check (len, 2, BT_INTEGER) == FAILURE)
return FAILURE;
+ if (pos->expr_type == EXPR_CONSTANT)
+ {
+ int p;
+ gfc_extract_int (pos, &p);
+ if (p < 0)
+ {
+ gfc_error ("'pos' at %L must be nonnegative", &pos->where);
+ return FAILURE;
+ }
+ }
+
+ if (len->expr_type == EXPR_CONSTANT)
+ {
+ int l;
+ gfc_extract_int (len, &l);
+ if (l < 0)
+ {
+ gfc_error ("'len' at %L must be nonnegative", &len->where);
+ return FAILURE;
+ }
+ }
+
+ if (pos->expr_type == EXPR_CONSTANT && len->expr_type == EXPR_CONSTANT)
+ {
+ int p, l;
+ gfc_extract_int (pos, &p);
+ gfc_extract_int (len, &l);
+ p += l;
+ l = gfc_validate_kind (BT_INTEGER, i->ts.kind, false);
+ if (p > gfc_integer_kinds[l].bit_size)
+ {
+ gfc_error ("'pos + len' at %L must be less than or equal "
+ "to BIT_SIZE('I')", &pos->where);
+ return FAILURE;
+ }
+ }
+
return SUCCESS;
}
@@ -3646,6 +3683,68 @@ gfc_check_mvbits (gfc_expr *from, gfc_ex
if (type_check (topos, 4, BT_INTEGER) == FAILURE)
return FAILURE;
+ if (frompos->expr_type == EXPR_CONSTANT)
+ {
+ int p;
+ gfc_extract_int (frompos, &p);
+ if (p < 0)
+ {
+ gfc_error ("'frompos' at %L must be nonnegative", &frompos->where);
+ return FAILURE;
+ }
+ }
+
+ if (topos->expr_type == EXPR_CONSTANT)
+ {
+ int p;
+ gfc_extract_int (topos, &p);
+ if (p < 0)
+ {
+ gfc_error ("'topos' at %L must be nonnegative", &topos->where);
+ return FAILURE;
+ }
+ }
+
+ if (len->expr_type == EXPR_CONSTANT)
+ {
+ int l;
+ gfc_extract_int (len, &l);
+
+ if (l < 0)
+ {
+ gfc_error ("'len' at %L must be nonnegative", &len->where);
+ return FAILURE;
+ }
+
+ if (frompos->expr_type == EXPR_CONSTANT)
+ {
+ int f, i;
+ gfc_extract_int (frompos, &f);
+ f += l;
+ i = gfc_validate_kind (BT_INTEGER, from->ts.kind, false);
+ if (f > gfc_integer_kinds[i].bit_size)
+ {
+ gfc_error ("'frompos + len' at %L must be less than or equal "
+ "to BIT_SIZE('from')", &frompos->where);
+ return FAILURE;
+ }
+ }
+
+ if (topos->expr_type == EXPR_CONSTANT)
+ {
+ int t, i;
+ gfc_extract_int (topos, &t);
+ t += l;
+ i = gfc_validate_kind (BT_INTEGER, to->ts.kind, false);
+ if (t > gfc_integer_kinds[i].bit_size)
+ {
+ gfc_error ("'topos + len' at %L must be less than or equal "
+ "to BIT_SIZE('to')", &topos->where);
+ return FAILURE;
+ }
+ }
+ }
+
return SUCCESS;
}
Index: testsuite/gfortran.dg/ibits_1.f90
===================================================================
--- testsuite/gfortran.dg/ibits_1.f90 (revision 0)
+++ testsuite/gfortran.dg/ibits_1.f90 (revision 0)
@@ -0,0 +1,13 @@
+! { dg-do compile }
+!
+! PR fortran/44346
+! Original test sumbitted by Vittorio Zecca, zeccav at gmail dot com.
+! Modified by Steven G. Kargl for dejagnu testsuite.
+!
+program a
+ integer :: j, i = 42
+ j = ibits(i, -1, 1) ! { dg-error "must be nonnegative" }
+ j = ibits(i, 1, -1) ! { dg-error "must be nonnegative" }
+ j = ibits(i, 100, 100) ! { dg-error "must be less than" }
+end program a
+
Index: testsuite/gfortran.dg/mvbits_9.f90
===================================================================
--- testsuite/gfortran.dg/mvbits_9.f90 (revision 0)
+++ testsuite/gfortran.dg/mvbits_9.f90 (revision 0)
@@ -0,0 +1,19 @@
+! { dg-do compile }
+!
+! PR fortran/44346
+! Original test sumbitted by Vittorio Zecca, zeccav at gmail dot com.
+! Modified by Steven G. Kargl for dejagnu testsuite.
+!
+program a
+ integer :: n = 42
+ ! 64 + 3 > bitsize(n)
+ call mvbits(n, 64, 3, n, 1) ! { dg-error "must be less than" }
+ ! 64 + 2 > bitsize(n)
+ call mvbits(n, 30, 2, n, 64) ! { dg-error "must be less than" }
+ ! LEN negative
+ call mvbits(n, 30, -2, n, 30) ! { dg-error "must be nonnegative" }
+ ! TOPOS negative
+ call mvbits(n, 30, 2, n, -3) ! { dg-error "must be nonnegative" }
+ ! FROMPOS negative
+ call mvbits(n, -1, 2, n, 3) ! { dg-error "must be nonnegative" }
+end program a