+2019-08-10 Steven G. Kargl <kargl@gcc.gnu.org>
+
+ * decl.c (match_old_style_init): Use a clearer error message.
+ * expr.c (gfc_check_assign): Update BOZ checking to provide a stricter
+ adherence to the Fortran standard. Use gfc_invalid_boz () to
+ relax errors into warnings.
+ * gfortran.h (gfc_isym_id): Add new ids GFC_ISYM_DFLOAT,
+ GFC_ISYM_FLOAT, GFC_ISYM_REALPART, and GFC_ISYM_SNGL
+ * intrinsic.c (add_functions): Use new ids to split REAL generic into
+ REAL, FLOAT, DFLOAT, SNGL, and REALPART generics.
+ (gfc_intrinsic_func_interface): Allow new intrinsics in an
+ initialization expression
+ * resolve.c (resolve_operator): Deal with BOZ as operands.
+ Use gfc_invalid_boz to allow for errors or warnings via the
+ -fallow-invalid-boz option. A BOZ cannot be an operand to an
+ unary operator. Both operands of a binary operator cannot be BOZ.
+ For binary operators, convert a BOZ operand into the type and
+ kind of the other operand for REAL or INTEGER operand.
+ * trans-intrinsic.c: Use new ids to cause conversions to happen.
+
2019-08-06 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/91359
&& nd->var->expr->ts.type != BT_REAL
&& nd->value->expr->ts.type == BT_BOZ)
{
- gfc_error ("Mismatch in variable type and BOZ literal constant "
- "at %L in an old-style initialization",
- &nd->value->expr->where);
+ gfc_error ("BOZ literal constant near %L cannot be assigned to "
+ "a %qs variable in an old-style initialization",
+ &nd->value->expr->where,
+ gfc_typename (&nd->value->expr->ts));
return MATCH_ERROR;
}
}
&& !gfc_check_conformance (lvalue, rvalue, "array assignment"))
return false;
- if (rvalue->ts.type == BT_BOZ && lvalue->ts.type != BT_INTEGER
- && lvalue->symtree->n.sym->attr.data
- && !gfc_notify_std (GFC_STD_GNU, "BOZ literal at %L used to "
- "initialize non-integer variable %qs",
- &rvalue->where, lvalue->symtree->n.sym->name))
- return false;
- else if (rvalue->ts.type == BT_BOZ && !lvalue->symtree->n.sym->attr.data
- && !gfc_notify_std (GFC_STD_GNU, "BOZ literal at %L outside "
- "a DATA statement and outside INT/REAL/DBLE/CMPLX",
- &rvalue->where))
- return false;
-
/* Handle the case of a BOZ literal on the RHS. */
if (rvalue->ts.type == BT_BOZ)
{
- /* FIXME BOZ. Need gfc_invalid_boz() here?. */
+ if (lvalue->symtree->n.sym->attr.data)
+ {
+ if (lvalue->ts.type == BT_INTEGER
+ && gfc_boz2int (rvalue, lvalue->ts.kind))
+ return true;
+
+ if (lvalue->ts.type == BT_REAL
+ && gfc_boz2real (rvalue, lvalue->ts.kind))
+ {
+ if (gfc_invalid_boz ("BOZ literal constant near %L cannot "
+ "be assigned to a REAL variable",
+ &rvalue->where))
+ return false;
+ return true;
+ }
+ }
+
+ if (!lvalue->symtree->n.sym->attr.data
+ && gfc_invalid_boz ("BOZ literal constant at %L is neither a "
+ "data-stmt-constant nor an actual argument to "
+ "INT, REAL, DBLE, or CMPLX intrinsic function",
+ &rvalue->where))
+ return false;
+
if (lvalue->ts.type == BT_INTEGER
&& gfc_boz2int (rvalue, lvalue->ts.kind))
return true;
+
if (lvalue->ts.type == BT_REAL
&& gfc_boz2real (rvalue, lvalue->ts.kind))
return true;
+ gfc_error ("BOZ literal constant near %L cannot be assigned to a "
+ "%qs variable", &rvalue->where, gfc_typename (&lvalue->ts));
+
return false;
}
GFC_ISYM_C_SIZEOF,
GFC_ISYM_DATE_AND_TIME,
GFC_ISYM_DBLE,
+ GFC_ISYM_DFLOAT,
GFC_ISYM_DIGITS,
GFC_ISYM_DIM,
GFC_ISYM_DOT_PRODUCT,
GFC_ISYM_FGET,
GFC_ISYM_FGETC,
GFC_ISYM_FINDLOC,
+ GFC_ISYM_FLOAT,
GFC_ISYM_FLOOR,
GFC_ISYM_FLUSH,
GFC_ISYM_FNUM,
GFC_ISYM_RANGE,
GFC_ISYM_RANK,
GFC_ISYM_REAL,
+ GFC_ISYM_REALPART,
GFC_ISYM_RENAME,
GFC_ISYM_REPEAT,
GFC_ISYM_RESHAPE,
GFC_ISYM_SIZE,
GFC_ISYM_SLEEP,
GFC_ISYM_SIZEOF,
+ GFC_ISYM_SNGL,
GFC_ISYM_SPACING,
GFC_ISYM_SPREAD,
GFC_ISYM_SQRT,
gfc_check_real, gfc_simplify_real, gfc_resolve_real,
a, BT_UNKNOWN, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
+ make_generic ("real", GFC_ISYM_REAL, GFC_STD_F77);
+
/* This provides compatibility with g77. */
- add_sym_1 ("realpart", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
+ add_sym_1 ("realpart", GFC_ISYM_REALPART, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
gfc_check_fn_c, gfc_simplify_realpart, gfc_resolve_realpart,
a, BT_UNKNOWN, dr, REQUIRED);
- add_sym_1 ("float", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
+ make_generic ("realpart", GFC_ISYM_REALPART, GFC_STD_F77);
+
+ add_sym_1 ("float", GFC_ISYM_FLOAT, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
gfc_check_float, gfc_simplify_float, NULL,
a, BT_INTEGER, di, REQUIRED);
make_alias ("floatk", GFC_STD_GNU);
}
- add_sym_1 ("dfloat", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
+ make_generic ("float", GFC_ISYM_FLOAT, GFC_STD_F77);
+
+ add_sym_1 ("dfloat", GFC_ISYM_DFLOAT, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
gfc_check_float, gfc_simplify_dble, gfc_resolve_dble,
a, BT_REAL, dr, REQUIRED);
- add_sym_1 ("sngl", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
+ make_generic ("dfloat", GFC_ISYM_DFLOAT, GFC_STD_F77);
+
+ add_sym_1 ("sngl", GFC_ISYM_SNGL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
gfc_check_sngl, gfc_simplify_sngl, NULL,
a, BT_REAL, dd, REQUIRED);
- make_generic ("real", GFC_ISYM_REAL, GFC_STD_F77);
+ make_generic ("sngl", GFC_ISYM_SNGL, GFC_STD_F77);
add_sym_2 ("rename", GFC_ISYM_RENAME, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER, di,
GFC_STD_GNU, gfc_check_rename, NULL, gfc_resolve_rename,
}
if ((isym->id == GFC_ISYM_REAL || isym->id == GFC_ISYM_DBLE
- || isym->id == GFC_ISYM_CMPLX)
+ || isym->id == GFC_ISYM_CMPLX || isym->id == GFC_ISYM_FLOAT
+ || isym->id == GFC_ISYM_SNGL || isym->id == GFC_ISYM_DFLOAT)
&& gfc_init_expr_flag
&& !gfc_notify_std (GFC_STD_F2003, "Function %qs as initialization "
"expression at %L", name, &expr->where))
case INTRINSIC_PARENTHESES:
if (!gfc_resolve_expr (e->value.op.op1))
return false;
+ if (e->value.op.op1
+ && e->value.op.op1->ts.type == BT_BOZ && !e->value.op.op2)
+ {
+ gfc_error ("BOZ literal constant at %L cannot be an operand of "
+ "unary operator %qs", &e->value.op.op1->where,
+ gfc_op2string (e->value.op.op));
+ return false;
+ }
break;
}
op2 = e->value.op.op2;
dual_locus_error = false;
+ /* op1 and op2 cannot both be BOZ. */
+ if (op1 && op1->ts.type == BT_BOZ
+ && op2 && op2->ts.type == BT_BOZ)
+ {
+ gfc_error ("Operands at %L and %L cannot appear as operands of "
+ "binary operator %qs", &op1->where, &op2->where,
+ gfc_op2string (e->value.op.op));
+ return false;
+ }
+
if ((op1 && op1->expr_type == EXPR_NULL)
|| (op2 && op2->expr_type == EXPR_NULL))
{
break;
}
+ /* If op1 is BOZ, then op2 is not!. Try to convert to type of op2. */
+ if (op1->ts.type == BT_BOZ)
+ {
+ if (gfc_invalid_boz ("BOZ literal constant near %L cannot appear as "
+ "an operand of a relational operator",
+ &op1->where))
+ return false;
+
+ if (op2->ts.type == BT_INTEGER && !gfc_boz2int (op1, op2->ts.kind))
+ return false;
+
+ if (op2->ts.type == BT_REAL && !gfc_boz2real (op1, op2->ts.kind))
+ return false;
+ }
+
+ /* If op2 is BOZ, then op1 is not!. Try to convert to type of op2. */
+ if (op2->ts.type == BT_BOZ)
+ {
+ if (gfc_invalid_boz ("BOZ literal constant near %L cannot appear as "
+ "an operand of a relational operator",
+ &op2->where))
+ return false;
+
+ if (op1->ts.type == BT_INTEGER && !gfc_boz2int (op2, op1->ts.kind))
+ return false;
+
+ if (op1->ts.type == BT_REAL && !gfc_boz2real (op2, op1->ts.kind))
+ return false;
+ }
+
if (gfc_numeric_ts (&op1->ts) && gfc_numeric_ts (&op2->ts))
{
gfc_type_convert_binary (e, 1);
return false;
}
+
/* These must not be assign-calls! */
gcc_assert (!e->value.compcall.assign);
break;
case GFC_ISYM_CONVERSION:
- case GFC_ISYM_REAL:
- case GFC_ISYM_LOGICAL:
case GFC_ISYM_DBLE:
+ case GFC_ISYM_DFLOAT:
+ case GFC_ISYM_FLOAT:
+ case GFC_ISYM_LOGICAL:
+ case GFC_ISYM_REAL:
+ case GFC_ISYM_REALPART:
+ case GFC_ISYM_SNGL:
gfc_conv_intrinsic_conversion (se, expr);
break;
+2019-08-10 Steven G. Kargl <kargl@gcc.gnu.org>
+
+ * gfortran.dg/boz_8.f90: Adjust error messages.
+ * gfortran.dg/nan_4.f90: Ditto.
+ * gfortran.dg/boz_1.f90: Add -fallow-invalid-boz to dg-options,
+ and test for warnings.
+ * gfortran.dg/boz_3.f90: Ditto.
+ * gfortran.dg/boz_4.f90: Ditto.
+ * gfortran.dg/dec_structure_6.f90: Ditto.
+ * gfortran.dg/ibits.f90: Ditto.
+
2019-08-10 Iain Buclaw <ibuclaw@gdcproject.org>
PR d/91238
! { dg-do run }
-! { dg-options "-std=gnu" }
+! { dg-options "-std=gnu -fallow-invalid-boz" }
! Test the boz handling
program boz
implicit none
- integer(1), parameter :: b1 = b'00000001'
- integer(2), parameter :: b2 = b'0101010110101010'
- integer(4), parameter :: b4 = b'01110000111100001111000011110000'
+ integer(1), parameter :: b1 = b'00000001' ! { dg-warning "BOZ literal constant" }
+ integer(2), parameter :: b2 = b'0101010110101010' ! { dg-warning "BOZ literal constant" }
+ integer(4), parameter :: b4 = b'01110000111100001111000011110000' ! { dg-warning "BOZ literal constant" }
integer(8), parameter :: &
- & b8 = b'0111000011110000111100001111000011110000111100001111000011110000'
+ & b8 = b'0111000011110000111100001111000011110000111100001111000011110000' ! { dg-warning "BOZ literal constant" }
- integer(1), parameter :: o1 = o'12'
- integer(2), parameter :: o2 = o'4321'
- integer(4), parameter :: o4 = o'43210765'
- integer(8), parameter :: o8 = o'1234567076543210'
+ integer(1), parameter :: o1 = o'12' ! { dg-warning "BOZ literal constant" }
+ integer(2), parameter :: o2 = o'4321' ! { dg-warning "BOZ literal constant" }
+ integer(4), parameter :: o4 = o'43210765' ! { dg-warning "BOZ literal constant" }
+ integer(8), parameter :: o8 = o'1234567076543210' ! { dg-warning "BOZ literal constant" }
- integer(1), parameter :: z1 = z'a'
- integer(2), parameter :: z2 = z'ab'
- integer(4), parameter :: z4 = z'dead'
- integer(8), parameter :: z8 = z'deadbeef'
+ integer(1), parameter :: z1 = z'a' ! { dg-warning "BOZ literal constant" }
+ integer(2), parameter :: z2 = z'ab' ! { dg-warning "BOZ literal constant" }
+ integer(4), parameter :: z4 = z'dead' ! { dg-warning "BOZ literal constant" }
+ integer(8), parameter :: z8 = z'deadbeef' ! { dg-warning "BOZ literal constant" }
if (z1 /= 10_1) STOP 1
if (z2 /= 171_2) STOP 2
! { dg-do run }
-! { dg-options "-std=gnu" }
+! { dg-options "-std=gnu -fallow-invalid-boz" }
+!
! Test that the BOZ constant on the RHS, which are of different KIND than
! the LHS, are correctly converted.
!
implicit none
- integer(1), parameter :: b1 = b'000000000001111'
- integer(2), parameter :: b2 = b'00000000000000000111000011110000'
+ integer(1), parameter :: &
+ & b1 = b'000000000001111' ! { dg-warning "BOZ literal constant at" }
+ integer(2), parameter :: &
+ & b2 = b'00000000000000000111000011110000' ! { dg-warning "BOZ literal constant at" }
integer(4), parameter :: &
- & b4 = b'0000000000000000000000000000000001110000111100001111000011110000'
+ & b4 = b'0000000000000000000000000000000001110000111100001111000011110000' ! { dg-warning "BOZ literal constant at" }
- integer(1), parameter :: o1 = o'0012'
- integer(2), parameter :: o2 = o'0004321'
- integer(4), parameter :: o4 = o'0000000043210765'
+ integer(1), parameter :: o1 = o'0012' ! { dg-warning "BOZ literal constant at" }
+ integer(2), parameter :: o2 = o'0004321' ! { dg-warning "BOZ literal constant at" }
+ integer(4), parameter :: o4 = o'0000000043210765' ! { dg-warning "BOZ literal constant at" }
- integer(1), parameter :: z1 = z'0a'
- integer(2), parameter :: z2 = z'00ab'
- integer(4), parameter :: z4 = z'0000dead'
+ integer(1), parameter :: z1 = z'0a' ! { dg-warning "BOZ literal constant at" }
+ integer(2), parameter :: z2 = z'00ab' ! { dg-warning "BOZ literal constant at" }
+ integer(4), parameter :: z4 = z'0000dead' ! { dg-warning "BOZ literal constant at" }
if (b1 /= 15_1) STOP 1
if (b2 /= 28912_2) STOP 2
! { dg-do compile }
-! Test that the conversion of a BOZ constant that is too large for the
-! integer variable is caught by the compiler.
-!
-! In F2008 and F2018, overflow cannot happen.
+! { dg-options "-fallow-invalid-boz" }
!
program boz
implicit none
- integer(1), parameter :: b1 = b'0101010110101010'
- integer(2), parameter :: b2 = b'01110000111100001111000011110000'
+ integer(1), parameter :: b1 = b'0101010110101010' ! { dg-warning "BOZ literal constant" }
+ integer(2), parameter :: b2 = b'01110000111100001111000011110000' ! { dg-warning "BOZ literal constant" }
integer(4), parameter :: &
- & b4 = b'0111000011110000111100001111000011110000111100001111000011110000'
- integer(1), parameter :: o1 = o'1234567076543210'
- integer(2), parameter :: o2 = o'1234567076543210'
- integer(4), parameter :: o4 = o'1234567076543210'
- integer(1), parameter :: z1 = z'deadbeef'
- integer(2), parameter :: z2 = z'deadbeef'
- integer(4), parameter :: z4 = z'deadbeeffeed'
+ & b4 = b'0111000011110000111100001111000011110000111100001111000011110000' ! { dg-warning "BOZ literal constant" }
+ integer(1), parameter :: o1 = o'1234567076543210' ! { dg-warning "BOZ literal constant" }
+ integer(2), parameter :: o2 = o'1234567076543210' ! { dg-warning "BOZ literal constant" }
+ integer(4), parameter :: o4 = o'1234567076543210' ! { dg-warning "BOZ literal constant" }
+ integer(1), parameter :: z1 = z'deadbeef' ! { dg-warning "BOZ literal constant" }
+ integer(2), parameter :: z2 = z'deadbeef' ! { dg-warning "BOZ literal constant" }
+ integer(4), parameter :: z4 = z'deadbeeffeed' ! { dg-warning "BOZ literal constant" }
end program boz
-! { dg-prune-output "BOZ literal at" }
!
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 "a DATA statement value" }
-i = z'4455' ! { dg-error "a DATA statement value" }
+data i/z'111'/
+data r/z'4455'/ ! { dg-error "BOZ literal constant" }
+r = z'FFFF' ! { dg-error "BOZ literal constant" }
+i = z'4455' ! { dg-error "BOZ literal constant" }
r = real(z'FFFFFFFFF')
end
! { dg-do run }
-! { dg-options "-fdec-structure" }
+! { dg-options "-fdec-structure -fallow-invalid-boz" }
!
! Test old-style CLIST initializers in STRUCTURE.
!
integer o(as) /as*9/ ! ok, parameter array spec
integer p(2,2) /1,2,3,4/! ok
real q(3) /1_2,3.5,2.4E-12_8/ ! ok, with some implicit conversions
- integer :: canary = z'3D3D3D3D'
+ integer :: canary = z'3D3D3D3D' ! { dg-warning "BOZ literal constant" }
end structure
record /s8/ r8
! { dg-do run }
+! { dg-options "-fallow-invalid-boz" }
! 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 literal at .1. outside a DATA statement" }
+ integer(8), parameter :: &
+ & n = z'00000000FFFFFFFF' ! { dg-warning "BOZ literal constant" }
integer(8) i,j,k,m
j = 1
do i=1,70
!
program test
implicit none
- real(4), parameter :: r0 = z'FFFFFFFF'
+ real(4), parameter :: r0 = z'FFFFFFFF' ! { dg-warning "BOZ literal constant" }
real(4) r
- data r/z'FFFFFFFF'/
- r = z'FFFFFFFF' ! { dg-warning "neither a DATA statement value" }
+ data r/z'FFFFFFFF'/ ! { dg-warning "BOZ literal constant" }
+ r = z'FFFFFFFF' ! { dg-warning "BOZ literal constant" }
end program test
projects / platform / upstream / gcc.git / commitdiff