| Message ID | 54BC91C0.7060700@charter.net |
|---|---|
| State | New |
| Headers | show |
ping This PR has been marked as a regression, so I suppose we ought to get it fixed. On 01/18/2015 09:10 PM, Jerry DeLisle wrote: > I reopened this PR to do some cleanup and to address a use case presented by > Joost in comment #7 of the subject PR. > > The fundamental problem: if the variable containing the unit number in an > INQUIRE statement is of type KIND greater than 4 and the value is outside the > range of a KIND=4 we cannot test for it within the run-time library. Unit > numbers are passed to the run-time in the IOPARM structures as a KIND=4. KIND=8 > are cast into the KIND=4. The test case gfortran.dg/negative_unit_int8.f > illustrates a case where a bogus unit number can get passed to the library. > > To resolve this previously we built range checks in trans_io.c > (set_parameter_value) that tests the unit numbers and issues an error call to > the run-time library. This is fine for all statements except INQUIRE which > should not give an error. However, we do want to identify such an out-of-range > unit number as not existing. > > This patch changes this by renaming the previous set_parameter_value to > set_parameter_value_chk. I then created a new version of set_parameter_value > that does no checking so that it can be used where generating errors is not > needed. I have created two new functions which build code that tests for the > out of range cases specific to INQUIRE. If a bad unit number is found, the UNIT > value in the IOPARM structure is set to -2, a new reserved value. (after this > patch we will have reserved values -3 thru -9 still available for future uses) > > The definition of unit existence is adjusted to be any negative unit currently > connected having been created with NEWUNIT and all KIND=4 positive values. A -2 > indicating an invalid unit will, by default, return EXISTS=false. > > The behind the scenes testing is never seen in user space as shown here with an > -fdump-tree-original example from the negative_unit_int8.f . > > For non-INQUIRE cases: > > D.3384 = i; > if (D.3384 < -2147483647) > { > _gfortran_generate_error (&dt_parm.0, 5005, &"Unit number in I/O > statement too small" > [1]{lb: 1 sz: 1}); > } > if (D.3384 > 2147483647) > { > _gfortran_generate_error (&dt_parm.0, 5005, &"Unit number in I/O > statement too large" > [1]{lb: 1 sz: 1}); > } > dt_parm.0.common.unit = (integer(kind=4)) D.3384; > > For the new INQUIRE case: > > integer(kind=8) i; > > --- snip --- > > inquire_parm.4.common.unit = (integer(kind=4)) i;<---notice the conversion > to kind=4 here > D.3393 = i; > if (D.3393 < 0) > { > inquire_parm.4.common.unit = -2; > } > if (D.3393 > 2147483647) > { > inquire_parm.4.common.unit = -2; > } > > When all is acceptable, common.unit is untouched and the normal assignment has > happened. The users variable, in this case i, is untouched as well because of > the temporary D.3393. The IOPARM stucture is also temporary and not used again. > > The patch updates the test case mentioned above. > > Regression tested on x86-64 and Joost's case in the PR now works as expected. > > OK for trunk? > > Regards, > > Jerry > > > 2015-01-18 Jerry DeLisle <jvdelisle@gcc.gnu.org> > > PR fortran/61933 > * trans-io.c (set_parameter_value): Delete use of has_iostat. > Redefine to not generate any runtime error check calls. > (set_parameter_value_chk): Rename of the former > set_parameter_value with the runtimr error checks and fix > whitespace. (gfc_trans_io_inquire_check): New function that > builds a runtime conditional block to set the INQUIRE > common parameter block unit number to -2 when unit numbers > exceed positive KIND=4 limits. (set_parameter_value_inquire): > New function that builds the conditional expressions and calls > gfc_trans_io_inquire_check. (gfc_trans_open): Whitespace. For > unit, use the renamed set_parameter_value_chk. > (gfc_trans_close): Likewise use renamed function. > (build_filepos): Whitespace and use renamed function. > (gfc_trans_inquire): Whitespace and for unit use > set_parameter_value and set_parameter_value_inquire. > (gfc_trans_wait): Remove p->iostat from call to > set_parameter_value. Use new set_parameter_value_chk for unit. > (build_dt): Use the new set_parameter_value without p->iostat > and fix whitespace. Use set_parameter_value_chk for unit. > > 2015-01-18 Jerry DeLisle <jvdelisle@gcc.gnu.org> > > PR libgfortran/61933 > * io/inquire.c (inquire_via_unit): Set existing to true for > any negative unit that is currently connected and any positive > units within range of KIND=4 value. The unit value for any out > of range case that may occur if the user is using a KIND=8 will > have been set to -2 which is reserved and can never be opened, > and therefore the unit does not exist.
Hi Jerry, hi all, sorry for the slow patch review. I also still want to review your other inquire patch. Jerry DeLisle wrote: > The fundamental problem: if the variable containing the unit number in > an INQUIRE statement is of type KIND greater than 4 and the value is > outside the range of a KIND=4 we cannot test for it within the > run-time library. Unit numbers are passed to the run-time in the > IOPARM structures as a KIND=4. KIND=8 are cast into the KIND=4. The > test case gfortran.dg/negative_unit_int8.f illustrates a case where a > bogus unit number can get passed to the library. > > Regression tested on x86-64 and Joost's case in the PR now works as > expected. > OK for trunk? Mostly OK, however, some remarks are below. > 2015-01-18 Jerry DeLisle <jvdelisle@gcc.gnu.org> > > PR fortran/61933 > * trans-io.c (set_parameter_value): Delete use of has_iostat. > Redefine to not generate any runtime error check calls. > (set_parameter_value_chk): Rename of the former > set_parameter_value with the runtimr error checks and fix > whitespace. (gfc_trans_io_inquire_check): New function that > builds a runtime conditional block to set the INQUIRE > common parameter block unit number to -2 when unit numbers > exceed positive KIND=4 limits. (set_parameter_value_inquire): > New function that builds the conditional expressions and calls > gfc_trans_io_inquire_check. (gfc_trans_open): Whitespace. For > unit, use the renamed set_parameter_value_chk. > (gfc_trans_close): Likewise use renamed function. > (build_filepos): Whitespace and use renamed function. > (gfc_trans_inquire): Whitespace and for unit use > set_parameter_value and set_parameter_value_inquire. > (gfc_trans_wait): Remove p->iostat from call to > set_parameter_value. Use new set_parameter_value_chk for unit. > (build_dt): Use the new set_parameter_value without p->iostat > and fix whitespace. Use set_parameter_value_chk for unit. > > 2015-01-18 Jerry DeLisle <jvdelisle@gcc.gnu.org> > > PR libgfortran/61933 > * io/inquire.c (inquire_via_unit): Set existing to true for > any negative unit that is currently connected and any positive > units within range of KIND=4 value. The unit value for any out > of range case that may occur if the user is using a KIND=8 will > have been set to -2 which is reserved and can never be opened, > and therefore the unit does not exist. [...] > + /* The unit number -2 is reserved. No units can ever have this > + value. It is used here to signal to the runtime library that the > + inquire unit number is outside the allowable range and so cannot > + exist. It is needed when -fdefault-integer-8 is uesed. */ I don't know where this number is used, but I really should be a #define; if it is shared with libgfortran, it belongs to libgfortran.h. You wrote that -1 is also reserved and used; is the -1 somewhere defined? [Disclaimer: I have only browsed the other patch and do not recall whether it add, handles or #defines -1 - or whether -1 is already defined somewhere.] > + /* UNIT numbers should be greater than zero. */ > + i = gfc_validate_kind (BT_INTEGER, 4, false); > + cond = build2_loc (input_location, LT_EXPR, boolean_type_node, > + se.expr, > + fold_convert (TREE_TYPE (se.expr), > + integer_zero_node)); > + gfc_trans_io_inquire_check (cond, var, &se.pre); > + > + /* UNIT numbers should be less than the max. */ > + val = gfc_conv_mpz_to_tree (gfc_integer_kinds[i].huge, 4); > + cond = build2_loc (input_location, GT_EXPR, boolean_type_node, > + se.expr, > + fold_convert (TREE_TYPE (se.expr), val)); > + gfc_trans_io_inquire_check (cond, var, &se.pre); The conditions could be combined with a fold_build2_loc(...,TRUTH_AND_EXPR,...). Thanks for the patch! Cheers, Tobias
Index: gcc/fortran/trans-io.c =================================================================== --- gcc/fortran/trans-io.c (revision 219703) +++ gcc/fortran/trans-io.c (working copy) @@ -512,7 +512,37 @@ set_parameter_const (stmtblock_t *block, tree var, st_parameter_XXX structure. This is a pass by value. */ static unsigned int -set_parameter_value (stmtblock_t *block, bool has_iostat, tree var, +set_parameter_value (stmtblock_t *block, tree var, enum iofield type, + gfc_expr *e) +{ + gfc_se se; + tree tmp; + gfc_st_parameter_field *p = &st_parameter_field[type]; + tree dest_type = TREE_TYPE (p->field); + + gfc_init_se (&se, NULL); + gfc_conv_expr_val (&se, e); + + se.expr = convert (dest_type, se.expr); + gfc_add_block_to_block (block, &se.pre); + + if (p->param_type == IOPARM_ptype_common) + var = fold_build3_loc (input_location, COMPONENT_REF, + st_parameter[IOPARM_ptype_common].type, + var, TYPE_FIELDS (TREE_TYPE (var)), NULL_TREE); + + tmp = fold_build3_loc (input_location, COMPONENT_REF, dest_type, var, + p->field, NULL_TREE); + gfc_add_modify (block, tmp, se.expr); + return p->mask; +} + + +/* Similar to set_parameter_value except generate runtime + error checks. */ + +static unsigned int +set_parameter_value_chk (stmtblock_t *block, bool has_iostat, tree var, enum iofield type, gfc_expr *e) { gfc_se se; @@ -550,7 +580,6 @@ static unsigned int gfc_trans_io_runtime_check (has_iostat, cond, var, LIBERROR_BAD_UNIT, "Unit number in I/O statement too large", &se.pre); - } se.expr = convert (dest_type, se.expr); @@ -568,6 +597,78 @@ static unsigned int } +/* Set the unit number in the inquire parameter block to -2. */ + +static void +gfc_trans_io_inquire_check (tree cond, tree var, stmtblock_t * pblock) +{ + stmtblock_t block; + tree body; + + gfc_start_block (&block); + + /* The unit number -2 is reserved. No units can ever have this + value. It is used here to signal to the runtime library that the + inquire unit number is outside the allowable range and so cannot + exist. It is needed when -fdefault-integer-8 is uesed. */ + + set_parameter_const (&block, var, IOPARM_common_unit, -2); + + body = gfc_finish_block (&block); + + var = build3_v (COND_EXPR, cond, body, build_empty_stmt (input_location)); + gfc_add_expr_to_block (pblock, var); +} + + +/* Build code to check the unit range if KIND=8 is used. Similar to + set_parameter_value_chk but we do not generate error calls for + inquire statements. */ + +static unsigned int +set_parameter_value_inquire (stmtblock_t *block, tree var, + enum iofield type, gfc_expr *e) +{ + gfc_se se; + gfc_st_parameter_field *p = &st_parameter_field[type]; + tree dest_type = TREE_TYPE (p->field); + + gfc_init_se (&se, NULL); + gfc_conv_expr_val (&se, e); + + /* If we're inquiring on a UNIT number, we need to check to make + sure it exists for larger than kind = 4. */ + if (type == IOPARM_common_unit && e->ts.kind > 4) + { + tree cond, val; + int i; + + /* Don't evaluate the UNIT number multiple times. */ + se.expr = gfc_evaluate_now (se.expr, &se.pre); + + /* UNIT numbers should be greater than zero. */ + i = gfc_validate_kind (BT_INTEGER, 4, false); + cond = build2_loc (input_location, LT_EXPR, boolean_type_node, + se.expr, + fold_convert (TREE_TYPE (se.expr), + integer_zero_node)); + gfc_trans_io_inquire_check (cond, var, &se.pre); + + /* UNIT numbers should be less than the max. */ + val = gfc_conv_mpz_to_tree (gfc_integer_kinds[i].huge, 4); + cond = build2_loc (input_location, GT_EXPR, boolean_type_node, + se.expr, + fold_convert (TREE_TYPE (se.expr), val)); + gfc_trans_io_inquire_check (cond, var, &se.pre); + } + + se.expr = convert (dest_type, se.expr); + gfc_add_block_to_block (block, &se.pre); + + return p->mask; +} + + /* Generate code to store a non-string I/O parameter into the st_parameter_XXX structure. This is pass by reference. */ @@ -978,7 +1079,7 @@ gfc_trans_open (gfc_code * code) mask |= set_string (&block, &post_block, var, IOPARM_open_form, p->form); if (p->recl) - mask |= set_parameter_value (&block, p->iostat, var, IOPARM_open_recl_in, + mask |= set_parameter_value (&block, var, IOPARM_open_recl_in, p->recl); if (p->blank) @@ -1029,7 +1130,7 @@ gfc_trans_open (gfc_code * code) set_parameter_const (&block, var, IOPARM_common_flags, mask); if (p->unit) - set_parameter_value (&block, p->iostat, var, IOPARM_common_unit, p->unit); + set_parameter_value_chk (&block, p->iostat, var, IOPARM_common_unit, p->unit); else set_parameter_const (&block, var, IOPARM_common_unit, 0); @@ -1082,7 +1183,7 @@ gfc_trans_close (gfc_code * code) set_parameter_const (&block, var, IOPARM_common_flags, mask); if (p->unit) - set_parameter_value (&block, p->iostat, var, IOPARM_common_unit, p->unit); + set_parameter_value_chk (&block, p->iostat, var, IOPARM_common_unit, p->unit); else set_parameter_const (&block, var, IOPARM_common_unit, 0); @@ -1124,8 +1225,8 @@ build_filepos (tree function, gfc_code * code) p->iomsg); if (p->iostat) - mask |= set_parameter_ref (&block, &post_block, var, IOPARM_common_iostat, - p->iostat); + mask |= set_parameter_ref (&block, &post_block, var, + IOPARM_common_iostat, p->iostat); if (p->err) mask |= IOPARM_common_err; @@ -1133,7 +1234,8 @@ build_filepos (tree function, gfc_code * code) set_parameter_const (&block, var, IOPARM_common_flags, mask); if (p->unit) - set_parameter_value (&block, p->iostat, var, IOPARM_common_unit, p->unit); + set_parameter_value_chk (&block, p->iostat, var, IOPARM_common_unit, + p->unit); else set_parameter_const (&block, var, IOPARM_common_unit, 0); @@ -1225,10 +1327,8 @@ gfc_trans_inquire (gfc_code * code) p->file); if (p->exist) - { - mask |= set_parameter_ref (&block, &post_block, var, IOPARM_inquire_exist, + mask |= set_parameter_ref (&block, &post_block, var, IOPARM_inquire_exist, p->exist); - } if (p->opened) mask |= set_parameter_ref (&block, &post_block, var, IOPARM_inquire_opened, @@ -1360,7 +1460,10 @@ gfc_trans_inquire (gfc_code * code) set_parameter_const (&block, var, IOPARM_common_flags, mask); if (p->unit) - set_parameter_value (&block, p->iostat, var, IOPARM_common_unit, p->unit); + { + set_parameter_value (&block, var, IOPARM_common_unit, p->unit); + set_parameter_value_inquire (&block, var, IOPARM_common_unit, p->unit); + } else set_parameter_const (&block, var, IOPARM_common_unit, 0); @@ -1407,12 +1510,12 @@ gfc_trans_wait (gfc_code * code) mask |= IOPARM_common_err; if (p->id) - mask |= set_parameter_value (&block, p->iostat, var, IOPARM_wait_id, p->id); + mask |= set_parameter_value (&block, var, IOPARM_wait_id, p->id); set_parameter_const (&block, var, IOPARM_common_flags, mask); if (p->unit) - set_parameter_value (&block, p->iostat, var, IOPARM_common_unit, p->unit); + set_parameter_value_chk (&block, p->iostat, var, IOPARM_common_unit, p->unit); tmp = gfc_build_addr_expr (NULL_TREE, var); tmp = build_call_expr_loc (input_location, @@ -1706,12 +1809,11 @@ build_dt (tree function, gfc_code * code) IOPARM_dt_id, dt->id); if (dt->pos) - mask |= set_parameter_value (&block, dt->iostat, var, IOPARM_dt_pos, - dt->pos); + mask |= set_parameter_value (&block, var, IOPARM_dt_pos, dt->pos); if (dt->asynchronous) - mask |= set_string (&block, &post_block, var, IOPARM_dt_asynchronous, - dt->asynchronous); + mask |= set_string (&block, &post_block, var, + IOPARM_dt_asynchronous, dt->asynchronous); if (dt->blank) mask |= set_string (&block, &post_block, var, IOPARM_dt_blank, @@ -1738,8 +1840,7 @@ build_dt (tree function, gfc_code * code) dt->sign); if (dt->rec) - mask |= set_parameter_value (&block, dt->iostat, var, IOPARM_dt_rec, - dt->rec); + mask |= set_parameter_value (&block, var, IOPARM_dt_rec, dt->rec); if (dt->advance) mask |= set_string (&block, &post_block, var, IOPARM_dt_advance, @@ -1791,8 +1892,8 @@ build_dt (tree function, gfc_code * code) set_parameter_const (&block, var, IOPARM_common_flags, mask); if (dt->io_unit && dt->io_unit->ts.type == BT_INTEGER) - set_parameter_value (&block, dt->iostat, var, IOPARM_common_unit, - dt->io_unit); + set_parameter_value_chk (&block, dt->iostat, var, + IOPARM_common_unit, dt->io_unit); } else set_parameter_const (&block, var, IOPARM_common_flags, mask); Index: gcc/testsuite/gfortran.dg/negative_unit_int8.f =================================================================== --- gcc/testsuite/gfortran.dg/negative_unit_int8.f (revision 219703) +++ gcc/testsuite/gfortran.dg/negative_unit_int8.f (working copy) @@ -30,6 +30,6 @@ ! This one is nasty inquire (unit=i, exist=l, iostat=i) if (l) call abort - if (i.ne.ERROR_BAD_UNIT) call abort + if (i.ne.0) call abort end Index: libgfortran/io/inquire.c =================================================================== --- libgfortran/io/inquire.c (revision 219703) +++ libgfortran/io/inquire.c (working copy) @@ -45,7 +45,8 @@ inquire_via_unit (st_parameter_inquire *iqp, gfc_u generate_error (&iqp->common, LIBERROR_INQUIRE_INTERNAL_UNIT, NULL); if ((cf & IOPARM_INQUIRE_HAS_EXIST) != 0) - *iqp->exist = (u != NULL); + *iqp->exist = (u != NULL) || (iqp->common.unit >= 0 + && iqp->common.unit <= GFC_INTEGER_4_HUGE); if ((cf & IOPARM_INQUIRE_HAS_OPENED) != 0) *iqp->opened = (u != NULL);
I reopened this PR to do some cleanup and to address a use case presented by Joost in comment #7 of the subject PR. The fundamental problem: if the variable containing the unit number in an INQUIRE statement is of type KIND greater than 4 and the value is outside the range of a KIND=4 we cannot test for it within the run-time library. Unit numbers are passed to the run-time in the IOPARM structures as a KIND=4. KIND=8 are cast into the KIND=4. The test case gfortran.dg/negative_unit_int8.f illustrates a case where a bogus unit number can get passed to the library. To resolve this previously we built range checks in trans_io.c (set_parameter_value) that tests the unit numbers and issues an error call to the run-time library. This is fine for all statements except INQUIRE which should not give an error. However, we do want to identify such an out-of-range unit number as not existing. This patch changes this by renaming the previous set_parameter_value to set_parameter_value_chk. I then created a new version of set_parameter_value that does no checking so that it can be used where generating errors is not needed. I have created two new functions which build code that tests for the out of range cases specific to INQUIRE. If a bad unit number is found, the UNIT value in the IOPARM structure is set to -2, a new reserved value. (after this patch we will have reserved values -3 thru -9 still available for future uses) The definition of unit existence is adjusted to be any negative unit currently connected having been created with NEWUNIT and all KIND=4 positive values. A -2 indicating an invalid unit will, by default, return EXISTS=false. The behind the scenes testing is never seen in user space as shown here with an -fdump-tree-original example from the negative_unit_int8.f . For non-INQUIRE cases: D.3384 = i; if (D.3384 < -2147483647) { _gfortran_generate_error (&dt_parm.0, 5005, &"Unit number in I/O statement too small" [1]{lb: 1 sz: 1}); } if (D.3384 > 2147483647) { _gfortran_generate_error (&dt_parm.0, 5005, &"Unit number in I/O statement too large" [1]{lb: 1 sz: 1}); } dt_parm.0.common.unit = (integer(kind=4)) D.3384; For the new INQUIRE case: integer(kind=8) i; --- snip --- inquire_parm.4.common.unit = (integer(kind=4)) i;<---notice the conversion to kind=4 here D.3393 = i; if (D.3393 < 0) { inquire_parm.4.common.unit = -2; } if (D.3393 > 2147483647) { inquire_parm.4.common.unit = -2; } When all is acceptable, common.unit is untouched and the normal assignment has happened. The users variable, in this case i, is untouched as well because of the temporary D.3393. The IOPARM stucture is also temporary and not used again. The patch updates the test case mentioned above. Regression tested on x86-64 and Joost's case in the PR now works as expected. OK for trunk? Regards, Jerry 2015-01-18 Jerry DeLisle <jvdelisle@gcc.gnu.org> PR fortran/61933 * trans-io.c (set_parameter_value): Delete use of has_iostat. Redefine to not generate any runtime error check calls. (set_parameter_value_chk): Rename of the former set_parameter_value with the runtimr error checks and fix whitespace. (gfc_trans_io_inquire_check): New function that builds a runtime conditional block to set the INQUIRE common parameter block unit number to -2 when unit numbers exceed positive KIND=4 limits. (set_parameter_value_inquire): New function that builds the conditional expressions and calls gfc_trans_io_inquire_check. (gfc_trans_open): Whitespace. For unit, use the renamed set_parameter_value_chk. (gfc_trans_close): Likewise use renamed function. (build_filepos): Whitespace and use renamed function. (gfc_trans_inquire): Whitespace and for unit use set_parameter_value and set_parameter_value_inquire. (gfc_trans_wait): Remove p->iostat from call to set_parameter_value. Use new set_parameter_value_chk for unit. (build_dt): Use the new set_parameter_value without p->iostat and fix whitespace. Use set_parameter_value_chk for unit. 2015-01-18 Jerry DeLisle <jvdelisle@gcc.gnu.org> PR libgfortran/61933 * io/inquire.c (inquire_via_unit): Set existing to true for any negative unit that is currently connected and any positive units within range of KIND=4 value. The unit value for any out of range case that may occur if the user is using a KIND=8 will have been set to -2 which is reserved and can never be opened, and therefore the unit does not exist.