diff options
Diffstat (limited to 'libgfortran/io/transfer.c')
| -rw-r--r-- | libgfortran/io/transfer.c | 62 |
1 files changed, 58 insertions, 4 deletions
diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c index a86099d..64f394d 100644 --- a/libgfortran/io/transfer.c +++ b/libgfortran/io/transfer.c @@ -56,6 +56,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see transfer_complex transfer_real128 transfer_complex128 + transfer_unsigned and for WRITE @@ -67,6 +68,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see transfer_complex_write transfer_real128_write transfer_complex128_write + transfer_unsigned_write These subroutines do not return status. The *128 functions are in the file transfer128.c. @@ -82,6 +84,12 @@ export_proto(transfer_integer); extern void transfer_integer_write (st_parameter_dt *, void *, int); export_proto(transfer_integer_write); +extern void transfer_unsigned (st_parameter_dt *, void *, int); +export_proto(transfer_unsigned); + +extern void transfer_unsigned_write (st_parameter_dt *, void *, int); +export_proto(transfer_unsigned_write); + extern void transfer_real (st_parameter_dt *, void *, int); export_proto(transfer_real); @@ -1410,6 +1418,9 @@ type_name (bt type) case BT_INTEGER: p = "INTEGER"; break; + case BT_UNSIGNED: + p = "UNSIGNED"; + break; case BT_LOGICAL: p = "LOGICAL"; break; @@ -1485,6 +1496,31 @@ require_type (st_parameter_dt *dtp, bt expected, bt actual, const fnode *f) return 1; } +/* Check that the actual matches one of two expected types; issue an error + if that is not the case. */ + + +static int +require_one_of_two_types (st_parameter_dt *dtp, bt expected1, bt expected2, + bt actual, const fnode *f) +{ + char buffer[BUFLEN]; + + if (actual == expected1) + return 0; + + if (actual == expected2) + return 0; + + snprintf (buffer, BUFLEN, + "Expected %s or %s for item %d in formatted transfer, got %s", + type_name (expected1), type_name (expected2), + dtp->u.p.item_count - 1, type_name (actual)); + + format_error (dtp, f, buffer); + return 1; + +} /* Check that the dtio procedure required for formatted IO is present. */ @@ -1627,9 +1663,12 @@ formatted_transfer_scalar_read (st_parameter_dt *dtp, bt type, void *p, int kind case FMT_I: if (n == 0) goto need_read_data; - if (require_type (dtp, BT_INTEGER, type, f)) + if (require_one_of_two_types (dtp, BT_INTEGER, BT_UNSIGNED, type, f)) return; - read_decimal (dtp, f, p, kind); + if (type == BT_INTEGER) + read_decimal (dtp, f, p, kind); + else + read_decimal_unsigned (dtp, f, p, kind); break; case FMT_B: @@ -2123,9 +2162,12 @@ formatted_transfer_scalar_write (st_parameter_dt *dtp, bt type, void *p, int kin case FMT_I: if (n == 0) goto need_data; - if (require_type (dtp, BT_INTEGER, type, f)) + if (require_one_of_two_types (dtp, BT_INTEGER, BT_UNSIGNED, type, f)) return; - write_i (dtp, f, p, kind); + if (type == BT_INTEGER) + write_i (dtp, f, p, kind); + else + write_iu (dtp, f, p, kind); break; case FMT_B: @@ -2609,6 +2651,18 @@ transfer_integer_write (st_parameter_dt *dtp, void *p, int kind) } void +transfer_unsigned (st_parameter_dt *dtp, void *p, int kind) +{ + wrap_scalar_transfer (dtp, BT_UNSIGNED, p, kind, kind, 1); +} + +void +transfer_unsigned_write (st_parameter_dt *dtp, void *p, int kind) +{ + transfer_unsigned (dtp, p, kind); +} + +void transfer_real (st_parameter_dt *dtp, void *p, int kind) { size_t size; |