FreeChainXenon/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

re PR fortran/34342 (BOZ extensions not diagnosed as such with -std=f95)

Browse source 
2007-12-08  Tobias Burnus  <burnus@net-b.de>

        PR fortran/34342
        PR fortran/34345
        PR fortran/18026
        PR fortran/29471

        * gfortran.texi (BOZ literal constants): Improve documentation
        and adapt for BOZ changes.
        * Make-lang.ini (resolve.o): Add target-memory.h dependency.
        * gfortran.h (gfc_expr): Add is_boz flag.
        * expr.c: Include target-memory.h.
        (gfc_check_assign): Support transferring BOZ for real/cmlx.
        * resolve.c: Include target-memory.h
        (resolve_ordinary_assign): Support transferring BOZ for real/cmlx.
        * target-memory.c (gfc_convert_boz): New function.
        * target-memory.c (gfc_convert_boz): Add prototype.
        * primary.c (match_boz_constant): Set is_boz, enable F95 error
        also without -pedantic, and allow for Fortran 2003 BOZ.
        (match_real_constant): Fix comment.
        * simplify.c
        * (simplify_cmplx,gfc_simplify_dble,gfc_simplify_float,
        gfc_simplify_real): Support Fortran 2003 BOZ.

2007-12-08  Tobias Burnus  <burnus@net-b.de>

        PR fortran/34342
        PR fortran/34345
        PR fortran/18026
        PR fortran/29471

        * gfortran.dg/boz_8.f90: New.
        * gfortran.dg/boz_9.f90: New.
        * gfortran.dg/boz_10.f90: New.
        * gfortran.dg/boz_7.f90: Update dg-warning.
        * gfortran.dg/pr16433.f: Add dg-error.
        * gfortan.dg/ibits.f90: Update dg-warning.
        * gfortran.dg/unf_io_convert_1.f90: Update/delete dg-warning.
        * gfortran.dg/unf_io_convert_2.f90: Ditto.

From-SVN: r130713
This commit is contained in:
Tobias Burnus 2007-12-08 22:46:56 +01:00 • committed by Tobias Burnus
parent 1b271c9ba3
commit 00a4618b3f
19 changed files with 394 additions and 44 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

23
gcc/fortran/ChangeLog
View file

@ -1,3 +1,26 @@
2007-12-08 Tobias Burnus <burnus@net-b.de>
PR fortran/34342
PR fortran/34345
PR fortran/18026
PR fortran/29471
* gfortran.texi (BOZ literal constants): Improve documentation
and adapt for BOZ changes.
* Make-lang.ini (resolve.o): Add target-memory.h dependency.
* gfortran.h (gfc_expr): Add is_boz flag.
* expr.c: Include target-memory.h.
(gfc_check_assign): Support transferring BOZ for real/cmlx.
* resolve.c: Include target-memory.h
(resolve_ordinary_assign): Support transferring BOZ for real/cmlx.
* target-memory.c (gfc_convert_boz): New function.
* target-memory.c (gfc_convert_boz): Add prototype.
* primary.c (match_boz_constant): Set is_boz, enable F95 error
also without -pedantic, and allow for Fortran 2003 BOZ.
(match_real_constant): Fix comment.
* simplify.c (simplify_cmplx,gfc_simplify_dble,gfc_simplify_float,
gfc_simplify_real): Support Fortran 2003 BOZ.
2007-12-08 Jakub Jelinek <jakub@redhat.com>
PR fortran/34359

2
gcc/fortran/Make-lang.in
View file

@ -324,6 +324,6 @@ fortran/trans-intrinsic.o: $(GFORTRAN_TRANS_DEPS) fortran/mathbuiltins.def \
gt-fortran-trans-intrinsic.h
fortran/dependency.o: $(GFORTRAN_TRANS_DEPS) fortran/dependency.h
fortran/trans-common.o: $(GFORTRAN_TRANS_DEPS) $(TARGET_H) $(RTL_H)
fortran/resolve.o: fortran/dependency.h fortran/data.h
fortran/resolve.o: fortran/dependency.h fortran/data.h fortran/target-memory.h
fortran/data.o: fortran/data.h
fortran/options.o: $(PARAMS_H) $(TARGET_H)

24
gcc/fortran/expr.c
View file

@ -24,6 +24,7 @@ along with GCC; see the file COPYING3. If not see
#include "gfortran.h"
#include "arith.h"
#include "match.h"
#include "target-memory.h" /* for gfc_convert_boz */
/* Get a new expr node. */
@ -2723,6 +2724,29 @@ gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue, int conform)
&& gfc_check_conformance ("array assignment", lvalue, rvalue) != SUCCESS)
return FAILURE;
if (rvalue->is_boz && lvalue->ts.type != BT_INTEGER
&& lvalue->symtree->n.sym->attr.data
&& gfc_notify_std (GFC_STD_GNU, "Extension: BOZ literal at %L used to "
"initialize non-integer variable '%s'",
&rvalue->where, lvalue->symtree->n.sym->name)
== FAILURE)
return FAILURE;
else if (rvalue->is_boz && !lvalue->symtree->n.sym->attr.data
&& gfc_notify_std (GFC_STD_GNU, "Extension: BOZ literal at %L outside "
"a DATA statement and outside INT/REAL/DBLE/CMPLX",
&rvalue->where) == FAILURE)
return FAILURE;
/* Handle the case of a BOZ literal on the RHS. */
if (rvalue->is_boz && lvalue->ts.type != BT_INTEGER)
{
if (gfc_option.warn_surprising)
gfc_warning ("BOZ literal at %L is bitwise transferred "
"non-integer symbol '%s'", &rvalue->where,
lvalue->symtree->n.sym->name);
gfc_convert_boz (rvalue, &lvalue->ts);
}
if (gfc_compare_types (&lvalue->ts, &rvalue->ts))
return SUCCESS;

2
gcc/fortran/gfortran.h
View file

@ -1430,7 +1430,7 @@ typedef struct gfc_expr
/* True if the expression is a call to a function that returns an array,
and if we have decided not to allocate temporary data for that array. */
unsigned int inline_noncopying_intrinsic : 1;
unsigned int inline_noncopying_intrinsic : 1, is_boz : 1;
/* Used to quickly find a given constructor by its offset. */
splay_tree con_by_offset;

56
gcc/fortran/gfortran.texi
View file

@ -862,6 +862,9 @@ Renaming of operators in the @code{USE} statement.
@cindex ISO C Bindings
Interoperability with C (ISO C Bindings)
@item
BOZ as argument of INT, REAL, DBLE and CMPLX.
@end itemize
@ -1084,26 +1087,45 @@ of the @code{READ} statement, and the output item lists of the
@section BOZ literal constants
@cindex BOZ literal constants
Besides decimal constants, Fortran also supports binary (@code{b}),
octal (@code{o}) and hexadecimal (@code{z}) integer constants. The
syntax is: @samp{prefix quote digits quote}, were the prefix is
either @code{b}, @code{o} or @code{z}, quote is either @code{'} or
@code{"} and the digits are for binary @code{0} or @code{1}, for
octal between @code{0} and @code{7}, and for hexadecimal between
@code{0} and @code{F}. (Example: @code{b'01011101'}.)
Up to Fortran 95, BOZ literals were only allowed to initialize
integer variables in DATA statements. Since Fortran 2003 BOZ literals
are also allowed as argument of @code{REAL}, @code{DBLE}, @code{INT}
and @code{CMPLX}; the result is the same as if the integer BOZ
literal had been converted by @code{TRANSFER} to, respectively,
@code{real}, @code{double precision}, @code{integer} or @code{complex}.
The GNU Fortran intrinsic procedure @code{FLOAT}, @code{DFLOAT},
@code{COMPLEX} and @code{DCMPLX} are treated alike.
As an extension, GNU Fortran allows hexadecimal BOZ literal constants to
be specified using the X prefix, in addition to the standard Z prefix.
BOZ literal constants can also be specified by adding a suffix to the
string. For example, @code{Z'ABC'} and @code{'ABC'Z} are equivalent.
be specified using the @code{X} prefix, in addition to the standard
@code{Z} prefix. The BOZ literal can also be specified by adding a
suffix to the string, for example, @code{Z'ABC'} and @code{'ABC'Z} are
equivalent.
The Fortran standard restricts the appearance of a BOZ literal constant
to the @code{DATA} statement, and it is expected to be assigned to an
@code{INTEGER} variable. GNU Fortran permits a BOZ literal to appear in
any initialization expression as well as assignment statements.
Furthermore, GNU Fortran allows using BOZ literal constants outside
DATA statements and the four intrinsic functions allowed by Fortran 2003.
In DATA statements, in direct assignments, where the right-hand side
only contains a BOZ literal constant, and for old-style initializers of
the form @code{integer i /o'0173'/}, the constant is transferred
as if @code{TRANSFER} had been used. In all other cases, the BOZ literal
constant is converted to an @code{INTEGER} value with
the largest decimal representation. This value is then converted
numerically to the type and kind of the variable in question.
(For instance @code{real :: r = b'0000001' + 1} initializes @code{r}
with @code{2.0}.) As different compilers implement the extension
differently, one should be careful when doing bitwise initialization
of non-integer variables.
Attempts to use a BOZ literal constant to do a bitwise initialization of
a variable can lead to confusion. A BOZ literal constant is converted
to an @code{INTEGER} value with the kind type with the largest decimal
representation, and this value is then converted numerically to the type
and kind of the variable in question. Thus, one should not expect a
bitwise copy of the BOZ literal constant to be assigned to a @code{REAL}
variable.
Similarly, initializing an @code{INTEGER} variable with a statement such
as @code{DATA i/Z'FFFFFFFF'/} will produce an integer overflow rather
Note that initializing an @code{INTEGER} variable with a statement such
as @code{DATA i/Z'FFFFFFFF'/} will give an integer overflow error rather
than the desired result of @math{-1} when @code{i} is a 32-bit integer
on a system that supports 64-bit integers. The @samp{-fno-range-check}
option can be used as a workaround for legacy code that initializes

11
gcc/fortran/primary.c
View file

@ -349,7 +349,7 @@ match_boz_constant (gfc_expr **result)
if (delim != '\'' && delim != '\"')
goto backup;
if (x_hex && pedantic
if (x_hex
&& (gfc_notify_std (GFC_STD_GNU, "Extension: Hexadecimal "
"constant at %C uses non-standard syntax")
== FAILURE))
@ -415,6 +415,9 @@ match_boz_constant (gfc_expr **result)
kind = gfc_max_integer_kind;
e = gfc_convert_integer (buffer, kind, radix, &gfc_current_locus);
/* Mark as boz variable. */
e->is_boz = 1;
if (gfc_range_check (e) != ARITH_OK)
{
gfc_error ("Integer too big for integer kind %i at %C", kind);
@ -422,10 +425,8 @@ match_boz_constant (gfc_expr **result)
return MATCH_ERROR;
}
/* FIXME: Fortran 2003 allows BOZ also in REAL(), CMPLX(), INT();
see PR18026 and PR29471. */
if (!gfc_in_match_data ()
&& (gfc_notify_std (GFC_STD_GNU, "Extension: BOZ used outside a DATA "
&& (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: BOZ used outside a DATA "
"statement at %C")
== FAILURE))
return MATCH_ERROR;
@ -440,7 +441,7 @@ backup:
/* Match a real constant of some sort. Allow a signed constant if signflag
is nonzero. Allow integer constants if allow_int is true. */
is nonzero. */
static match
match_real_constant (gfc_expr **result, int signflag)

20
gcc/fortran/resolve.c
View file

@ -28,6 +28,7 @@ along with GCC; see the file COPYING3. If not see
#include "arith.h" /* For gfc_compare_expr(). */
#include "dependency.h"
#include "data.h"
#include "target-memory.h" /* for gfc_simplify_transfer */
/* Types used in equivalence statements. */
@ -5885,7 +5886,6 @@ resolve_ordinary_assign (gfc_code *code, gfc_namespace *ns)
int n;
gfc_ref *ref;
if (gfc_extend_assign (code, ns) == SUCCESS)
{
lhs = code->ext.actual->expr;
@ -5912,6 +5912,24 @@ resolve_ordinary_assign (gfc_code *code, gfc_namespace *ns)
lhs = code->expr;
rhs = code->expr2;
if (rhs->is_boz
&& gfc_notify_std (GFC_STD_GNU, "Extension: BOZ literal at %L outside "
"a DATA statement and outside INT/REAL/DBLE/CMPLX",
&code->loc) == FAILURE)
return false;
/* Handle the case of a BOZ literal on the RHS. */
if (rhs->is_boz && lhs->ts.type != BT_INTEGER)
{
if (gfc_option.warn_surprising)
gfc_warning ("BOZ literal at %L is bitwise transferred "
"non-integer symbol '%s'", &code->loc,
lhs->symtree->n.sym->name);
gfc_convert_boz (rhs, &lhs->ts);
}
if (lhs->ts.type == BT_CHARACTER
&& gfc_option.warn_character_truncation)
{

61
gcc/fortran/simplify.c
View file

@ -740,7 +740,8 @@ simplify_cmplx (const char *name, gfc_expr *x, gfc_expr *y, int kind)
switch (x->ts.type)
{
case BT_INTEGER:
mpfr_set_z (result->value.complex.r, x->value.integer, GFC_RND_MODE);
if (!x->is_boz)
mpfr_set_z (result->value.complex.r, x->value.integer, GFC_RND_MODE);
break;
case BT_REAL:
@ -761,7 +762,8 @@ simplify_cmplx (const char *name, gfc_expr *x, gfc_expr *y, int kind)
switch (y->ts.type)
{
case BT_INTEGER:
mpfr_set_z (result->value.complex.i, y->value.integer, GFC_RND_MODE);
if (!y->is_boz)
mpfr_set_z (result->value.complex.i, y->value.integer, GFC_RND_MODE);
break;
case BT_REAL:
@ -773,6 +775,25 @@ simplify_cmplx (const char *name, gfc_expr *x, gfc_expr *y, int kind)
}
}
/* Handle BOZ. */
if (x->is_boz)
{
gfc_typespec ts;
ts.kind = result->ts.kind;
ts.type = BT_REAL;
gfc_convert_boz (x, &ts);
mpfr_set (result->value.complex.r, x->value.real, GFC_RND_MODE);
}
if (y && y->is_boz)
{
gfc_typespec ts;
ts.kind = result->ts.kind;
ts.type = BT_REAL;
gfc_convert_boz (y, &ts);
mpfr_set (result->value.complex.i, y->value.real, GFC_RND_MODE);
}
return range_check (result, name);
}
@ -918,7 +939,8 @@ gfc_simplify_dble (gfc_expr *e)
switch (e->ts.type)
{
case BT_INTEGER:
result = gfc_int2real (e, gfc_default_double_kind);
if (!e->is_boz)
result = gfc_int2real (e, gfc_default_double_kind);
break;
case BT_REAL:
@ -933,6 +955,15 @@ gfc_simplify_dble (gfc_expr *e)
gfc_internal_error ("gfc_simplify_dble(): bad type at %L", &e->where);
}
if (e->ts.type == BT_INTEGER && e->is_boz)
{
gfc_typespec ts;
ts.type = BT_REAL;
ts.kind = gfc_default_double_kind;
result = gfc_copy_expr (e);
gfc_convert_boz (result, &ts);
}
return range_check (result, "DBLE");
}
@ -1111,7 +1142,18 @@ gfc_simplify_float (gfc_expr *a)
if (a->expr_type != EXPR_CONSTANT)
return NULL;
result = gfc_int2real (a, gfc_default_real_kind);
if (a->is_boz)
{
gfc_typespec ts;
ts.type = BT_REAL;
ts.kind = gfc_default_real_kind;
result = gfc_copy_expr (a);
gfc_convert_boz (result, &ts);
}
else
result = gfc_int2real (a, gfc_default_real_kind);
return range_check (result, "FLOAT");
}
@ -2954,7 +2996,8 @@ gfc_simplify_real (gfc_expr *e, gfc_expr *k)
switch (e->ts.type)
{
case BT_INTEGER:
result = gfc_int2real (e, kind);
if (!e->is_boz)
result = gfc_int2real (e, kind);
break;
case BT_REAL:
@ -2970,6 +3013,14 @@ gfc_simplify_real (gfc_expr *e, gfc_expr *k)
/* Not reached */
}
if (e->ts.type == BT_INTEGER && e->is_boz)
{
gfc_typespec ts;
ts.type = BT_REAL;
ts.kind = kind;
result = gfc_copy_expr (e);
gfc_convert_boz (result, &ts);
}
return range_check (result, "REAL");
}

43
gcc/fortran/target-memory.c
View file

@ -595,3 +595,46 @@ gfc_merge_initializers (gfc_typespec ts, gfc_expr *e, unsigned char *data,
return len;
}
void
gfc_convert_boz (gfc_expr *expr, gfc_typespec *ts)
{
size_t buffer_size;
unsigned char *buffer;
if (!expr->is_boz)
return;
gcc_assert (expr->expr_type == EXPR_CONSTANT
&& expr->ts.type == BT_INTEGER);
/* Don't convert BOZ to logical, character, derived etc. */
if (ts->type == BT_REAL)
buffer_size = size_float (ts->kind);
else if (ts->type == BT_COMPLEX)
buffer_size = size_complex (ts->kind);
else
return;
buffer_size = MAX (buffer_size, size_integer (expr->ts.kind));
buffer = (unsigned char*)alloca (buffer_size);
encode_integer (expr->ts.kind, expr->value.integer, buffer, buffer_size);
mpz_clear (expr->value.integer);
if (ts->type == BT_REAL)
{
mpfr_init (expr->value.real);
gfc_interpret_float (ts->kind, buffer, buffer_size, expr->value.real);
}
else
{
mpfr_init (expr->value.complex.r);
mpfr_init (expr->value.complex.i);
gfc_interpret_complex (ts->kind, buffer, buffer_size,
expr->value.complex.r, expr->value.complex.i);
}
expr->is_boz = 0;
expr->ts.type = ts->type;
expr->ts.kind = ts->kind;
}

3
gcc/fortran/target-memory.h
View file

@ -24,6 +24,9 @@ along with GCC; see the file COPYING3. If not see
#include "gfortran.h"
/* Convert a BOZ to REAL or COMPLEX. */
void gfc_convert_boz (gfc_expr *, gfc_typespec *);
/* Return the size of an expression in its target representation. */
size_t gfc_target_expr_size (gfc_expr *);

16
gcc/testsuite/ChangeLog
View file

@ -1,3 +1,19 @@
2007-12-06 Tobias Burnus <burnus@net-b.de>
PR fortran/34342
PR fortran/34345
PR fortran/18026
PR fortran/29471
* gfortran.dg/boz_8.f90: New.
* gfortran.dg/boz_9.f90: New.
* gfortran.dg/boz_10.f90: New.
* gfortran.dg/boz_7.f90: Update dg-warning.
* gfortran.dg/pr16433.f: Add dg-error.
* gfortan.dg/ibits.f90: Update dg-warning.
* gfortran.dg/unf_io_convert_1.f90: Update/delete dg-warning.
* gfortran.dg/unf_io_convert_2.f90: Ditto.
2007-12-08 Jakub Jelinek <jakub@redhat.com>
PR fortran/34359

15
gcc/testsuite/gfortran.dg/boz_10.f90 Normal file
View file

@ -0,0 +1,15 @@
! { dg-do compile }
! { dg-options "-std=f95" }
!
! PR fortran/34342
!
! Diagnose BOZ literal for non-integer variables in
! a DATA statement. And outside DATA statements.
!
real :: r
integer :: i
r = real(z'FFFF') ! { dg-error "outside a DATA statement" }
i = int(z'4455') ! { dg-error "outside a DATA statement" }
r = z'FFFF' + 1.0 ! { dg-error "outside a DATA statement" }
i = z'4455' + 1 ! { dg-error "outside a DATA statement" }
end

2
gcc/testsuite/gfortran.dg/boz_7.f90
View file

@ -6,7 +6,7 @@
! Some BOZ extensions where not diagnosed
!
integer :: k, m
integer :: j = z'000abc' ! { dg-error "Extension: BOZ used outside a DATA statement" }
integer :: j = z'000abc' ! { dg-error "BOZ used outside a DATA statement" }
data k/x'0003'/ ! { dg-error "uses non-standard syntax" }
data m/'0003'z/ ! { dg-error "uses non-standard postfix syntax" }
end

16
gcc/testsuite/gfortran.dg/boz_8.f90 Normal file
View file

@ -0,0 +1,16 @@
! { dg-do compile }
! { dg-options "-std=f2003" }
!
! PR fortran/34342
!
! Diagnose BOZ literal for non-integer variables in
! a DATA statement. Cf. Fortran 2003, 5.2.5 DATA statement:
! "If a data-stmt-constant is a boz-literal-constant, the
! corresponding variable shall be of type integer."
!
real :: r
integer :: i
data i/z'111'/, r/z'4455'/ ! { dg-error "BOZ literal at .1. used to initialize non-integer variable 'r'" }
r = z'FFFF' ! { dg-error "outside a DATA statement" }
i = z'4455' ! { dg-error "outside a DATA statement" }
end

118
gcc/testsuite/gfortran.dg/boz_9.f90 Normal file
View file

@ -0,0 +1,118 @@
! { dg-do run }
! { dg-options "-fno-range-check" }
!
! PR fortran/34342
!
! Test for Fortran 2003 BOZ.
!
program f2003
implicit none
real,parameter :: r2c = real(int(z'3333'))
real,parameter :: rc = real(z'3333')
double precision,parameter :: dc = dble(Z'3FD34413509F79FF')
complex,parameter :: z1c = cmplx(b'10101',-4.0)
complex,parameter :: z2c = cmplx(5.0, o'01245')
real :: r2 = real(int(z'3333'))
real :: r = real(z'3333')
double precision :: d = dble(Z'3FD34413509F79FF')
complex :: z1 = cmplx(b'10101',-4.0)
complex :: z2 = cmplx(5.0, o'01245')
if (r2c /= 13107.0) stop '1'
if (rc /= 1.83668190E-41) stop '2'
if (dc /= 0.30102999566398120) stop '3'
if (real(z1c) /= 2.94272678E-44 .or. aimag(z1c) /= -4.0) stop '4'
if (real(z2c) /= 5.0 .or. aimag(z2c) /= 9.48679060E-43) stop '5'
if (r2 /= 13107.0) stop '1'
if (r /= 1.83668190E-41) stop '2'
if (d /= 0.30102999566398120) stop '3'
if (real(z1) /= 2.94272678E-44 .or. aimag(z1) /= -4.0) stop '4'
if (real(z2) /= 5.0 .or. aimag(z2) /= 9.48679060E-43) stop '5'
r2 = dble(int(z'3333'))
r = real(z'3333')
d = dble(Z'3FD34413509F79FF')
z1 = cmplx(b'10101',-4.0)
z2 = cmplx(5.0, o'01245')
if (r2 /= 13107.0) stop '1'
if (r /= 1.83668190E-41) stop '2'
if (d /= 0.30102999566398120) stop '3'
if (real(z1) /= 2.94272678E-44 .or. aimag(z1) /= -4.0) stop '4'
if (real(z2) /= 5.0 .or. aimag(z2) /= 9.48679060E-43) stop '5'
call test4()
call test8()
contains
subroutine test4
real,parameter :: r2c = real(int(z'3333', kind=4), kind=4)
real,parameter :: rc = real(z'3333', kind=4)
complex,parameter :: z1c = cmplx(b'10101',-4.0, kind=4)
complex,parameter :: z2c = cmplx(5.0, o'01245', kind=4)
real :: r2 = real(int(z'3333', kind=4), kind=4)
real :: r = real(z'3333', kind=4)
complex :: z1 = cmplx(b'10101',-4.0, kind=4)
complex :: z2 = cmplx(5.0, o'01245', kind=4)
if (r2c /= 13107.0) stop '1'
if (rc /= 1.83668190E-41) stop '2'
if (real(z1c) /= 2.94272678E-44 .or. aimag(z1c) /= -4.0) stop '4'
if (real(z2c) /= 5.0 .or. aimag(z2c) /= 9.48679060E-43) stop '5'
if (r2 /= 13107.0) stop '1'
if (r /= 1.83668190E-41) stop '2'
if (real(z1) /= 2.94272678E-44 .or. aimag(z1) /= -4.0) stop '4'
if (real(z2) /= 5.0 .or. aimag(z2) /= 9.48679060E-43) stop '5'
r2 = real(int(z'3333'), kind=4)
r = real(z'3333', kind=4)
z1 = cmplx(b'10101',-4.0, kind=4)
z2 = cmplx(5.0, o'01245', kind=4)
if (r2 /= 13107.0) stop '1'
if (r /= 1.83668190E-41) stop '2'
if (real(z1) /= 2.94272678E-44 .or. aimag(z1) /= -4.0) stop '4'
if (real(z2) /= 5.0 .or. aimag(z2) /= 9.48679060E-43) stop '5'
end subroutine test4
subroutine test8
real(8),parameter :: r2c = real(int(z'FFFFFF3333', kind=8), kind=8)
real(8),parameter :: rc = real(z'AAAAAAAAAAAAAAAAFFFFFFF3333', kind=8)
complex(8),parameter :: z1c = cmplx(b'11111011111111111111111111111111111111111111111111111111110101',-4.0, kind=8)
complex(8),parameter :: z2c = cmplx(5.0, o'444444444442222222222233301245', kind=8)
real(8) :: r2 = real(int(z'FFFFFF3333',kind=8),kind=8)
real(8) :: r = real(z'AAAAAAAAAAAAAAAAFFFFFFF3333', kind=8)
complex(8) :: z1 = cmplx(b'11111011111111111111111111111111111111111111111111111111110101',-4.0, kind=8)
complex(8) :: z2 = cmplx(5.0, o'444444444442222222222233301245', kind=8)
if (r2c /= 1099511575347.0d0) stop '1'
if (rc /= -3.72356884822177915d-103) stop '2'
if (real(z1c) /= 3.05175781249999627d-5 .or. aimag(z1c) /= -4.0) stop '4'
if (real(z2c) /= 5.0 .or. aimag(z2c) /= 3.98227593015308981d41) stop '5'
if (r2 /= 1099511575347.0d0) stop '1'
if (r /= -3.72356884822177915d-103) stop '2'
if (real(z1) /= 3.05175781249999627d-5 .or. aimag(z1) /= -4.0) stop '4'
if (real(z2) /= 5.0 .or. aimag(z2) /= 3.98227593015308981d41) stop '5'
r2 = real(int(z'FFFFFF3333',kind=8),kind=8)
r = real(z'AAAAAAAAAAAAAAAAFFFFFFF3333', kind=8)
z1 = cmplx(b'11111011111111111111111111111111111111111111111111111111110101',-4.0, kind=8)
z2 = cmplx(5.0, o'444444444442222222222233301245', kind=8)
if (r2 /= 1099511575347.0d0) stop '1'
if (r /= -3.72356884822177915d-103) stop '2'
if (real(z1) /= 3.05175781249999627d-5 .or. aimag(z1) /= -4.0) stop '4'
if (real(z2) /= 5.0 .or. aimag(z2) /= 3.98227593015308981d41) stop '5'
end subroutine test8
end program f2003

2
gcc/testsuite/gfortran.dg/ibits.f90
View file

@ -2,7 +2,7 @@
! Test that the mask is properly converted to the kind type of j in ibits.
program ibits_test
implicit none
integer(8), parameter :: n = z'00000000FFFFFFFF' ! { dg-warning "BOZ used outside a DATA statement" }
integer(8), parameter :: n = z'00000000FFFFFFFF' ! { dg-warning "BOZ literal at .1. outside a DATA statement" }
integer(8) i,j,k,m
j = 1
do i=1,70

2
gcc/testsuite/gfortran.dg/pr16433.f
View file

@ -1,6 +1,6 @@
! { dg-do compile }
real x
double precision dx
data x/x'2ffde'/ ! { dg-warning "exadecimal constant" "Hex constant can't begin with x" }
data x/x'2ffde'/ ! { dg-warning "Hexadecimal constant | used to initialize non-integer" }
dx = x ! { dg-bogus "exadecimal constant" "Hex constant where there is none" }
end

12
gcc/testsuite/gfortran.dg/unf_io_convert_1.f90
View file

@ -18,9 +18,9 @@ program main
integer i
character*4 str
m(1) = Z'11223344' ! { dg-warning "BOZ used outside a DATA statement" }
m(2) = Z'55667788' ! { dg-warning "BOZ used outside a DATA statement" }
n = Z'77AABBCC' ! { dg-warning "BOZ used outside a DATA statement" }
m(1) = Z'11223344' ! { dg-warning "BOZ literal at .1. outside a DATA statement" }
m(2) = Z'55667788' ! { dg-warning "BOZ literal at .1. outside a DATA statement" }
n = Z'77AABBCC' ! { dg-warning "BOZ literal at .1. outside a DATA statement" }
str = 'asdf'
do i = 1,size
r(i) = i
@ -46,7 +46,7 @@ program main
read(9) str
!
! check results
if (m(1).ne.Z'11223344') then ! { dg-warning "BOZ used outside a DATA statement" }
if (m(1).ne.Z'11223344') then
if (debug) then
print '(A,Z8)','m(1) incorrect. m(1) = ',m(1)
else
@ -54,7 +54,7 @@ program main
endif
endif
if (m(2).ne.Z'55667788') then ! { dg-warning "BOZ used outside a DATA statement" }
if (m(2).ne.Z'55667788') then
if (debug) then
print '(A,Z8)','m(2) incorrect. m(2) = ',m(2)
else
@ -62,7 +62,7 @@ program main
endif
endif
if (n.ne.Z'77AABBCC') then ! { dg-warning "BOZ used outside a DATA statement" }
if (n.ne.Z'77AABBCC') then
if (debug) then
print '(A,Z8)','n incorrect. n = ',n
else

10
gcc/testsuite/gfortran.dg/unf_io_convert_2.f90
View file

@ -15,26 +15,26 @@ program main
close(10,status="delete")
open (10, form="unformatted",convert="big_endian") ! { dg-warning "Extension: CONVERT" }
i = (/ Z'11223344', Z'55667700' /) ! { dg-warning "BOZ used outside a DATA statement" }
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' /))) & ! { dg-warning "BOZ used outside a DATA statement" }
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 ! { dg-warning "BOZ used outside a DATA statement" }
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' /))) & ! { dg-warning "BOZ used outside a DATA statement" }
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 ! { dg-warning "BOZ used outside a DATA statement" }
if (j /= Z'5566770011223344') call abort
close (10, status="delete")
end program main