PR fortran/23815: Add byte-swapping to gfortran
Thomas Koenig
Thomas.Koenig@online.de
Tue Dec 6 21:42:00 GMT 2005
Uh... forgot to copy gcc-patches.
:ADDPATCH fortran:
OK for mainline?
----- Forwarded message from Thomas Koenig <Thomas.Koenig@online.de> -----
To: Thomas Koenig <Thomas.Koenig@online.de>
Cc: FX Coudert <fxcoudert@gmail.com>, gfortran <fortran@gcc.gnu.org>
Subject: Re: PR fortran/23815: Add byte-swapping to gfortran
From: Thomas Koenig <Thomas.Koenig@online.de>
I wrote:
> I have to correct that: Updating and bootstrapping made the
> regressions disappear. I will submit a proper patch later.
Here we go. Regression-tested on i686-pc-linux-gnu. I propose
this one for mainline, because it is clearly new functionality.
OK?
Thomas
2005-12-04 Thomas Koenig <Thomas.Koenig@online.de>
PR fortran/23815
* io.c (top level): Add convert to io_tag.
(resolve_tag): convert is GFC_STD_GNU, complain only if
pedantic.
(match_open_element): Add convert.
(gfc_free_open): Likewise.
(gfc_resolve_open): Likewise.
(gfc_free_inquire): Likewise.
(match_inquire_element): Likewise.
* dump-parse-tree.c (gfc_show_code_node): Add
convet for open and inquire.
gfortran.h: Add convert to gfc_open and gfc_inquire.
* trans-io.c (gfc_trans_open): Add convert.
(gfc_trans_inquire): Likewise.
* ioparm.def: Add convert to open and inquire.
* gfortran.texi: Document CONVERT.
2005-12-04 Thomas Koenig <Thomas.Koenig@online.de>
PR fortran/23815
* io/file_pos.c (unformatted_backspace): If flags.convert
does not equal CONVERT_NATIVE, reverse the record marker.
* io/open.c: Add convert_opt[].
(st_open): If no convert option is given, set CONVERT_NATIVE.
If CONVERT_BIG or CONVERT_LITTLE are given, set flags.convert to
CONVERT_NATIVE or CONVERT_SWAP (depending on wether we have
a big- or little-endian system).
* io/transfer.c (unformatted_read): If we need to reverse
bytes, break up large transfers into a loop. Split complex
numbers into its two parts.
(unformatted_write): Likewise.
(us_read): If flags.convert does not equal CONVERT_NATIVE,
reverse the record marker.
(next_record_w): Likewise.
(reverse_memcpy): New function.
* io/inquire.c (inquire_via_unit): Implement convert.
* io/io.h (top level): Add enum unit_convert.
Add convert to st_parameter_open and st_parameter_inquire.
Define IOPARM_OPEN_HAS_CONVERT and IOPARM_INQUIRE_HAS_CONVERT.
Increase padding for st_parameter_dt.
Declare reverse_memcpy().
2005-12-04 Thomas Koenig <Thomas.Koenig@online.de>
PR fortran/23815
* gfortran.dg/unf_io_convert_1.f90: New test.
* gfortran.dg/unf_io_convert_2.f90: New test.
* gfortran.dg/unf_io_convert_3.f90: New test.
Index: gcc/fortran/io.c
===================================================================
--- gcc/fortran/io.c (revision 108010)
+++ gcc/fortran/io.c (working copy)
@@ -78,6 +78,7 @@ static const io_tag
tag_s_delim = {"DELIM", " delim = %v", BT_CHARACTER},
tag_s_pad = {"PAD", " pad = %v", BT_CHARACTER},
tag_iolength = {"IOLENGTH", " iolength = %v", BT_INTEGER},
+ tag_convert = {"CONVERT", " convert = %e", BT_CHARACTER},
tag_err = {"ERR", " err = %l", BT_UNKNOWN},
tag_end = {"END", " end = %l", BT_UNKNOWN},
tag_eor = {"EOR", " eor = %l", BT_UNKNOWN};
@@ -1051,6 +1052,12 @@ resolve_tag (const io_tag * tag, gfc_exp
&e->where) == FAILURE)
return FAILURE;
}
+ if (pedantic && tag == &tag_convert)
+ {
+ if (gfc_notify_std (GFC_STD_GNU, "Extension: CONVERT tag at %L",
+ &e->where) == FAILURE)
+ return FAILURE;
+ }
}
return SUCCESS;
@@ -1106,6 +1113,9 @@ match_open_element (gfc_open * open)
m = match_ltag (&tag_err, &open->err);
if (m != MATCH_NO)
return m;
+ m = match_etag (&tag_convert, &open->convert);
+ if (m != MATCH_NO)
+ return m;
return MATCH_NO;
}
@@ -1133,6 +1143,7 @@ gfc_free_open (gfc_open * open)
gfc_free_expr (open->action);
gfc_free_expr (open->delim);
gfc_free_expr (open->pad);
+ gfc_free_expr (open->convert);
gfc_free (open);
}
@@ -1158,6 +1169,7 @@ gfc_resolve_open (gfc_open * open)
RESOLVE_TAG (&tag_e_action, open->action);
RESOLVE_TAG (&tag_e_delim, open->delim);
RESOLVE_TAG (&tag_e_pad, open->pad);
+ RESOLVE_TAG (&tag_convert, open->convert);
if (gfc_reference_st_label (open->err, ST_LABEL_TARGET) == FAILURE)
return FAILURE;
@@ -2438,6 +2450,7 @@ gfc_free_inquire (gfc_inquire * inquire)
gfc_free_expr (inquire->delim);
gfc_free_expr (inquire->pad);
gfc_free_expr (inquire->iolength);
+ gfc_free_expr (inquire->convert);
gfc_free (inquire);
}
@@ -2479,6 +2492,7 @@ match_inquire_element (gfc_inquire * inq
RETM m = match_vtag (&tag_s_delim, &inquire->delim);
RETM m = match_vtag (&tag_s_pad, &inquire->pad);
RETM m = match_vtag (&tag_iolength, &inquire->iolength);
+ RETM m = match_vtag (&tag_convert, &inquire->convert);
RETM return MATCH_NO;
}
@@ -2632,6 +2646,7 @@ gfc_resolve_inquire (gfc_inquire * inqui
RESOLVE_TAG (&tag_s_delim, inquire->delim);
RESOLVE_TAG (&tag_s_pad, inquire->pad);
RESOLVE_TAG (&tag_iolength, inquire->iolength);
+ RESOLVE_TAG (&tag_convert, inquire->convert);
if (gfc_reference_st_label (inquire->err, ST_LABEL_TARGET) == FAILURE)
return FAILURE;
Index: gcc/fortran/gfortran.texi
===================================================================
--- gcc/fortran/gfortran.texi (revision 108010)
+++ gcc/fortran/gfortran.texi (working copy)
@@ -587,6 +587,7 @@ of extensions, and @option{-std=legacy}
* Implicitly interconvert LOGICAL and INTEGER::
* Hollerith constants support::
* Cray pointers::
+* CONVERT specifier::
@end menu
@node Old-style kind specifications
@@ -930,6 +931,42 @@ pointees are passed as arguments, they a
variables in the invoked function. Subsequent changes to the pointer
will not change the base address of the array that was passed.
+@node CONVERT specifier
+@section CONVERT specifier
+@cindex CONVERT specifier
+
+gfortran allows the conversion of unformatted data between little-
+and big-endian representation to facilitate moving of data
+between different systems. The conversion is indicated with
+the @code{CONVERT} specifier on the @code{OPEN} statement.
+
+Valid values for @code{CONVERT} are:
+@itemize @w{}
+@item @code{CONVERT='NATIVE'} Use the native format. This is the default.
+@item @code{CONVERT='SWAP'} Swap between little- and big-endian.
+@item @code{CONVERT='LITTLE_ENDIAN'} Use the little-endian format
+ for unformatted files.
+@item @code{CONVERT='BIG_ENDIAN'} Use the big-endian format for
+ unformatted files.
+@end itemize
+
+Using the option could look like this:
+@smallexample
+ open(file='big.dat',form='unformatted',access='sequential', &
+ convert='big_endian')
+@end smallexample
+
+The value of the conversion can be queried by using
+@code{INQUIRE(CONVERT=ch)}. The values returned are
+@code{'BIG_ENDIAN'} and @code{'LITTLE_ENDIAN'}.
+
+@code{CONVERT} works between big- and little-endian for
+@code{INTEGER} values of all supported kinds and for @code{REAL}
+on IEEE sytems of kinds 4 and 8. Conversion between different
+``extended double'' types on different architectures such as
+m68k and x86_64, which gfortran
+supports as @code{REAL(KIND=10)} will probably not work.
+
@c ---------------------------------------------------------------------
@include intrinsic.texi
@c ---------------------------------------------------------------------
Index: gcc/fortran/dump-parse-tree.c
===================================================================
--- gcc/fortran/dump-parse-tree.c (revision 108010)
+++ gcc/fortran/dump-parse-tree.c (working copy)
@@ -1148,6 +1148,11 @@ gfc_show_code_node (int level, gfc_code
gfc_status (" PAD=");
gfc_show_expr (open->pad);
}
+ if (open->convert)
+ {
+ gfc_status (" CONVERT=");
+ gfc_show_expr (open->convert);
+ }
if (open->err != NULL)
gfc_status (" ERR=%d", open->err->value);
@@ -1349,6 +1354,11 @@ gfc_show_code_node (int level, gfc_code
gfc_status (" PAD=");
gfc_show_expr (i->pad);
}
+ if (i->convert)
+ {
+ gfc_status (" CONVERT=");
+ gfc_show_expr (i->convert);
+ }
if (i->err != NULL)
gfc_status (" ERR=%d", i->err->value);
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h (revision 108010)
+++ gcc/fortran/gfortran.h (working copy)
@@ -1309,7 +1309,7 @@ gfc_alloc;
typedef struct
{
gfc_expr *unit, *file, *status, *access, *form, *recl,
- *blank, *position, *action, *delim, *pad, *iostat, *iomsg;
+ *blank, *position, *action, *delim, *pad, *iostat, *iomsg, *convert;
gfc_st_label *err;
}
gfc_open;
@@ -1336,7 +1336,7 @@ typedef struct
gfc_expr *unit, *file, *iostat, *exist, *opened, *number, *named,
*name, *access, *sequential, *direct, *form, *formatted,
*unformatted, *recl, *nextrec, *blank, *position, *action, *read,
- *write, *readwrite, *delim, *pad, *iolength, *iomsg;
+ *write, *readwrite, *delim, *pad, *iolength, *iomsg, *convert;
gfc_st_label *err;
Index: gcc/fortran/trans-io.c
===================================================================
--- gcc/fortran/trans-io.c (revision 108010)
+++ gcc/fortran/trans-io.c (working copy)
@@ -791,6 +791,10 @@ gfc_trans_open (gfc_code * code)
if (p->err)
mask |= IOPARM_common_err;
+ if (p->convert)
+ mask |= set_string (&block, &post_block, var, IOPARM_open_convert,
+ p->convert);
+
set_parameter_const (&block, var, IOPARM_common_flags, mask);
tmp = gfc_build_addr_expr (NULL_TREE, var);
@@ -1073,6 +1077,10 @@ gfc_trans_inquire (gfc_code * code)
if (p->err)
mask |= IOPARM_common_err;
+ if (p->convert)
+ mask |= set_string (&block, &post_block, var, IOPARM_inquire_convert,
+ p->convert);
+
set_parameter_const (&block, var, IOPARM_common_flags, mask);
tmp = gfc_build_addr_expr (NULL_TREE, var);
Index: gcc/fortran/ioparm.def
===================================================================
--- gcc/fortran/ioparm.def (revision 108010)
+++ gcc/fortran/ioparm.def (working copy)
@@ -25,6 +25,7 @@ IOPARM (open, position, 1 << 13, char
IOPARM (open, action, 1 << 14, char2)
IOPARM (open, delim, 1 << 15, char1)
IOPARM (open, pad, 1 << 16, char2)
+IOPARM (open, convert, 1 << 17, char1)
IOPARM (close, common, 0, common)
IOPARM (close, status, 1 << 7, char1)
IOPARM (filepos, common, 0, common)
@@ -51,6 +52,7 @@ IOPARM (inquire, unformatted, 1 << 25, c
IOPARM (inquire, read, 1 << 26, char2)
IOPARM (inquire, write, 1 << 27, char1)
IOPARM (inquire, readwrite, 1 << 28, char2)
+IOPARM (inquire, convert, 1 << 29, char1)
#ifndef IOPARM_dt_list_format
#define IOPARM_dt_list_format (1 << 7)
#define IOPARM_dt_namelist_read_mode (1 << 8)
Index: libgfortran/io/file_pos.c
===================================================================
--- libgfortran/io/file_pos.c (revision 108010)
+++ libgfortran/io/file_pos.c (working copy)
@@ -114,7 +114,12 @@ unformatted_backspace (st_parameter_file
if (p == NULL)
goto io_error;
- memcpy (&m, p, sizeof (gfc_offset));
+ /* Only CONVERT_NATIVE and CONVERT_SWAP are valid here. */
+ if (u->flags.convert == CONVERT_NATIVE)
+ memcpy (&m, p, sizeof (gfc_offset));
+ else
+ reverse_memcpy (&m, p, sizeof (gfc_offset));
+
new = file_position (u->s) - m - 2*length;
if (sseek (u->s, new) == FAILURE)
goto io_error;
Index: libgfortran/io/open.c
===================================================================
--- libgfortran/io/open.c (revision 108010)
+++ libgfortran/io/open.c (working copy)
@@ -98,6 +98,14 @@ static const st_option pad_opt[] =
{ NULL, 0}
};
+static const st_option convert_opt[] =
+{
+ { "native", CONVERT_NATIVE},
+ { "swap", CONVERT_SWAP},
+ { "big_endian", CONVERT_BIG},
+ { "little_endian", CONVERT_LITTLE},
+ { NULL, 0}
+};
/* Given a unit, test to see if the file is positioned at the terminal
point, and if so, change state from NO_ENDFILE flag to AT_ENDFILE.
@@ -531,6 +539,36 @@ st_open (st_parameter_open *opp)
find_option (&opp->common, opp->status, opp->status_len,
status_opt, "Bad STATUS parameter in OPEN statement");
+ if (cf & IOPARM_OPEN_HAS_CONVERT)
+ {
+ unit_convert conv;
+ conv = find_option (&opp->common, opp->convert, opp->convert_len,
+ convert_opt, "Bad CONVERT parameter in OPEN statement");
+ /* We use l8_to_l4_offset, which is 0 on little-endian machines
+ and 1 on big-endian machines. */
+ switch (conv)
+ {
+ case CONVERT_NATIVE:
+ case CONVERT_SWAP:
+ break;
+
+ case CONVERT_BIG:
+ conv = l8_to_l4_offset ? CONVERT_NATIVE : CONVERT_SWAP;
+ break;
+
+ case CONVERT_LITTLE:
+ conv = l8_to_l4_offset ? CONVERT_SWAP : CONVERT_NATIVE;
+ break;
+
+ default:
+ internal_error (&opp->common, "Illegal value for CONVERT");
+ break;
+ }
+ flags.convert = conv;
+ }
+ else
+ flags.convert = CONVERT_NATIVE;
+
if (opp->common.unit < 0)
generate_error (&opp->common, ERROR_BAD_OPTION,
"Bad unit number in OPEN statement");
Index: libgfortran/io/inquire.c
===================================================================
--- libgfortran/io/inquire.c (revision 108010)
+++ libgfortran/io/inquire.c (working copy)
@@ -283,6 +283,29 @@ inquire_via_unit (st_parameter_inquire *
cf_strcpy (iqp->pad, iqp->pad_len, p);
}
+
+ if ((cf & IOPARM_INQUIRE_HAS_CONVERT) != 0)
+ {
+ if (u == NULL)
+ p = undefined;
+ else
+ switch (u->flags.convert)
+ {
+ /* l8_to_l4_offset is 0 for little-endian, 1 for big-endian. */
+ case CONVERT_NATIVE:
+ p = l8_to_l4_offset ? "BIG_ENDIAN" : "LITTLE_ENDIAN";
+ break;
+
+ case CONVERT_SWAP:
+ p = l8_to_l4_offset ? "LITTLE_ENDIAN" : "BIG_ENDIAN";
+ break;
+
+ default:
+ internal_error (&iqp->common, "inquire_via_unit(): Bad convert");
+ }
+
+ cf_strcpy (iqp->convert, iqp->convert_len, p);
+ }
}
Index: libgfortran/io/io.h
===================================================================
--- libgfortran/io/io.h (revision 108010)
+++ libgfortran/io/io.h (working copy)
@@ -206,6 +206,10 @@ typedef enum
{READING, WRITING}
unit_mode;
+typedef enum
+{ CONVERT_NATIVE, CONVERT_SWAP, CONVERT_BIG, CONVERT_LITTLE }
+unit_convert;
+
#define CHARACTER1(name) \
char * name; \
gfc_charlen_type name ## _len
@@ -247,6 +251,7 @@ st_parameter_common;
#define IOPARM_OPEN_HAS_ACTION (1 << 14)
#define IOPARM_OPEN_HAS_DELIM (1 << 15)
#define IOPARM_OPEN_HAS_PAD (1 << 16)
+#define IOPARM_OPEN_HAS_CONVERT (1 << 17)
typedef struct
{
@@ -261,6 +266,7 @@ typedef struct
CHARACTER2 (action);
CHARACTER1 (delim);
CHARACTER2 (pad);
+ CHARACTER1 (convert);
}
st_parameter_open;
@@ -301,6 +307,7 @@ st_parameter_filepos;
#define IOPARM_INQUIRE_HAS_READ (1 << 26)
#define IOPARM_INQUIRE_HAS_WRITE (1 << 27)
#define IOPARM_INQUIRE_HAS_READWRITE (1 << 28)
+#define IOPARM_INQUIRE_HAS_CONVERT (1 << 29)
typedef struct
{
@@ -323,6 +330,7 @@ typedef struct
CHARACTER2 (read);
CHARACTER1 (write);
CHARACTER2 (readwrite);
+ CHARACTER1 (convert);
}
st_parameter_inquire;
@@ -415,7 +423,7 @@ typedef struct st_parameter_dt
kind. */
char value[32];
} p;
- char pad[16 * sizeof (char *) + 32 * sizeof (int)];
+ char pad[16 * sizeof (char *) + 34 * sizeof (int)];
} u;
}
st_parameter_dt;
@@ -434,6 +442,7 @@ typedef struct
unit_position position;
unit_status status;
unit_pad pad;
+ unit_convert convert;
}
unit_flags;
@@ -734,6 +743,9 @@ internal_proto(init_loop_spec);
extern void next_record (st_parameter_dt *, int);
internal_proto(next_record);
+extern void reverse_memcpy (void *, const void *, size_t);
+internal_proto (reverse_memcpy);
+
/* read.c */
extern void set_integer (void *, GFC_INTEGER_LARGEST, int);
Index: libgfortran/io/transfer.c
===================================================================
--- libgfortran/io/transfer.c (revision 108010)
+++ libgfortran/io/transfer.c (working copy)
@@ -393,9 +393,40 @@ unformatted_read (st_parameter_dt *dtp,
void *dest, int kind __attribute__((unused)),
size_t size, size_t nelems)
{
- size *= nelems;
-
- read_block_direct (dtp, dest, &size);
+ /* Currently, character implies size=1. */
+ if (dtp->u.p.current_unit->flags.convert == CONVERT_NATIVE
+ || size == 1 || type == BT_CHARACTER)
+ {
+ size *= nelems;
+ read_block_direct (dtp, dest, &size);
+ }
+ else
+ {
+ char buffer[16];
+ char *p;
+ size_t i, sz;
+
+ /* Break up complex into its constituent reals. */
+ if (type == BT_COMPLEX)
+ {
+ nelems *= 2;
+ size /= 2;
+ }
+ p = dest;
+
+ /* By now, all complex variables have been split into their
+ constituent reals. For types with padding, we only need to
+ read kind bytes. We don't care about the contents
+ of the padding. */
+
+ for (i=0; i<nelems; i++)
+ {
+ sz = kind;
+ read_block_direct (dtp, buffer, &sz);
+ reverse_memcpy (p, buffer, sz);
+ p += size;
+ }
+ }
}
@@ -406,9 +437,41 @@ unformatted_write (st_parameter_dt *dtp,
void *source, int kind __attribute__((unused)),
size_t size, size_t nelems)
{
- size *= nelems;
+ if (dtp->u.p.current_unit->flags.convert == CONVERT_NATIVE ||
+ size == 1 || type == BT_CHARACTER)
+ {
+ size *= nelems;
+
+ write_block_direct (dtp, source, &size);
+ }
+ else
+ {
+ char buffer[16];
+ char *p;
+ size_t i, sz;
+
+ /* Break up complex into its constituent reals. */
+ if (type == BT_COMPLEX)
+ {
+ nelems *= 2;
+ size /= 2;
+ }
+
+ p = source;
+
+ /* By now, all complex variables have been split into their
+ constituent reals. For types with padding, we only need to
+ read kind bytes. We don't care about the contents
+ of the padding. */
- write_block_direct (dtp, source, &size);
+ for (i=0; i<nelems; i++)
+ {
+ reverse_memcpy(buffer, p, size);
+ p+= size;
+ sz = kind;
+ write_block_direct (dtp, buffer, &sz);
+ }
+ }
}
@@ -1139,7 +1202,12 @@ us_read (st_parameter_dt *dtp)
return;
}
- memcpy (&i, p, sizeof (gfc_offset));
+ /* Only CONVERT_NATIVE and CONVERT_SWAP are valid here. */
+ if (dtp->u.p.current_unit->flags.convert == CONVERT_NATIVE)
+ memcpy (&i, p, sizeof (gfc_offset));
+ else
+ reverse_memcpy (&i, p, sizeof (gfc_offset));
+
dtp->u.p.current_unit->bytes_left = i;
}
@@ -1707,7 +1775,12 @@ next_record_w (st_parameter_dt *dtp)
if (p == NULL)
goto io_error;
- memcpy (p, &m, sizeof (gfc_offset));
+ /* Only CONVERT_NATIVE and CONVERT_SWAP are valid here. */
+ if (dtp->u.p.current_unit->flags.convert == CONVERT_NATIVE)
+ memcpy (p, &m, sizeof (gfc_offset));
+ else
+ reverse_memcpy (p, &m, sizeof (gfc_offset));
+
if (sfree (dtp->u.p.current_unit->s) == FAILURE)
goto io_error;
@@ -1718,7 +1791,12 @@ next_record_w (st_parameter_dt *dtp)
if (p == NULL)
generate_error (&dtp->common, ERROR_OS, NULL);
- memcpy (p, &m, sizeof (gfc_offset));
+ /* Only CONVERT_NATIVE and CONVERT_SWAP are valid here. */
+ if (dtp->u.p.current_unit->flags.convert == CONVERT_NATIVE)
+ memcpy (p, &m, sizeof (gfc_offset));
+ else
+ reverse_memcpy (p, &m, sizeof (gfc_offset));
+
if (sfree (dtp->u.p.current_unit->s) == FAILURE)
goto io_error;
@@ -2146,3 +2224,19 @@ st_set_nml_var_dim (st_parameter_dt *dtp
nml->dim[n].lbound = (ssize_t)lbound;
nml->dim[n].ubound = (ssize_t)ubound;
}
+
+/* Reverse memcpy - used for byte swapping. */
+
+void reverse_memcpy (void *dest, const void *src, size_t n)
+{
+ char *d, *s;
+ size_t i;
+
+ d = (char *) dest;
+ s = (char *) src + n - 1;
+
+ /* Write with ascending order - this is likely faster
+ on modern architectures because of write combining. */
+ for (i=0; i<n; i++)
+ *(d++) = *(s--);
+}
! { dg-do run }
! { dg-options "-pedantic" }
! This test verifies the most basic sequential unformatted I/O
! with convert="swap".
! Adapted from seq_io.f.
! write 3 records of various sizes
! then read them back
program main
implicit none
integer size
parameter(size=100)
logical debug
data debug /.FALSE./
! set debug to true for help in debugging failures.
integer m(2)
integer n
real*4 r(size)
integer i
character*4 str
m(1) = Z'11223344'
m(2) = Z'55667788'
n = Z'77AABBCC'
str = 'asdf'
do i = 1,size
r(i) = i
end do
open(9,form="unformatted",access="sequential",convert="swap") ! { dg-warning "Extension: CONVERT" }
write(9) m ! an array of 2
write(9) n ! an integer
write(9) r ! an array of reals
write(9)str ! String
! zero all the results so we can compare after they are read back
do i = 1,size
r(i) = 0
end do
m(1) = 0
m(2) = 0
n = 0
str = ' '
rewind(9)
read(9) m
read(9) n
read(9) r
read(9) str
!
! check results
if (m(1).ne.Z'11223344') then
if (debug) then
print '(A,Z8)','m(1) incorrect. m(1) = ',m(1)
else
call abort
endif
endif
if (m(2).ne.Z'55667788') then
if (debug) then
print '(A,Z8)','m(2) incorrect. m(2) = ',m(2)
else
call abort
endif
endif
if (n.ne.Z'77AABBCC') then
if (debug) then
print '(A,Z8)','n incorrect. n = ',n
else
call abort
endif
endif
do i = 1,size
if (int(r(i)).ne.i) then
if (debug) then
print*,'element ',i,' was ',r(i),' should be ',i
else
call abort
endif
endif
end do
if (str .ne. 'asdf') then
if (debug) then
print *,'str incorrect, str = ', str
else
call abort
endif
! use hexdump to look at the file "fort.9"
if (debug) then
close(9)
else
close(9,status='DELETE')
endif
end if
end program main
! { dg-do run }
program main
complex(kind=4) :: c
real(kind=4) :: a(2)
integer(kind=4) :: i(2)
integer(kind=1) :: b(8)
integer(kind=8) :: j
c = (3.14, 2.71)
open (10, form="unformatted",convert="swap") ! { dg-warning "Extension: CONVERT" }
write (10) c
rewind (10)
read (10) a
if (a(1) /= 3.14 .or. a(2) /= 2.71) call abort
close(10,status="delete")
open (10, form="unformatted",convert="big_endian") ! { dg-warning "Extension: CONVERT" }
i = (/ Z'11223344', Z'55667700' /)
write (10) i
rewind (10)
read (10) b
if (any(b /= (/ Z'11', Z'22', Z'33', Z'44', Z'55', Z'66', Z'77', Z'00' /))) &
call abort
backspace 10
read (10) j
if (j /= Z'1122334455667700') call abort
close (10, status="delete")
open (10, form="unformatted", convert="little_endian") ! { dg-warning "Extension: CONVERT" }
write (10) i
rewind (10)
read (10) b
if (any(b /= (/ Z'44', Z'33', Z'22', Z'11', Z'00', Z'77', Z'66', Z'55' /))) &
call abort
backspace 10
read (10) j
if (j /= Z'5566770011223344') call abort
end program main
! { dg-do run}
! { dg-require-effective-target fortran_large_real }
program main
integer,parameter :: k = selected_real_kind (precision (0.0_8) + 1)
real(kind=k) a,b,c
a = 1.1_k
open(10,convert="swap",form="unformatted") ! { dg-warning "Extension: CONVERT" }
write(10) a
backspace 10
read (10) b
close(10,status="delete")
if (a /= b) call abort
write (11) a
backspace 11
open (11,form="unformatted")
read (11) c
if (a .ne. c) call abort
close (11, status="delete")
end program main
----- End forwarded message -----
More information about the Gcc-patches
mailing list