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

decl.c (match_old_style_init): Use a clearer error message.

Browse source 
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-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.

From-SVN: r274257
This commit is contained in:
Steven G. Kargl 2019-08-10 18:26:13 +00:00
parent 884efbd523
commit 878f88b7d1
15 changed files with 185 additions and 70 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

20
gcc/fortran/ChangeLog
View file

@ -1,3 +1,23 @@
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

7
gcc/fortran/decl.c
View file

@ -579,9 +579,10 @@ match_old_style_init (const char *name)
&& 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;
}
}

41
gcc/fortran/expr.c
View file

@ -3641,29 +3641,44 @@ gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue, int conform,
&& !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;
}

4
gcc/fortran/gfortran.h
View file

@ -423,6 +423,7 @@ enum gfc_isym_id
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,
@ -448,6 +449,7 @@ enum gfc_isym_id
GFC_ISYM_FGET,
GFC_ISYM_FGETC,
GFC_ISYM_FINDLOC,
GFC_ISYM_FLOAT,
GFC_ISYM_FLOOR,
GFC_ISYM_FLUSH,
GFC_ISYM_FNUM,
@ -573,6 +575,7 @@ enum gfc_isym_id
GFC_ISYM_RANGE,
GFC_ISYM_RANK,
GFC_ISYM_REAL,
GFC_ISYM_REALPART,
GFC_ISYM_RENAME,
GFC_ISYM_REPEAT,
GFC_ISYM_RESHAPE,
@ -598,6 +601,7 @@ enum gfc_isym_id
GFC_ISYM_SIZE,
GFC_ISYM_SLEEP,
GFC_ISYM_SIZEOF,
GFC_ISYM_SNGL,
GFC_ISYM_SPACING,
GFC_ISYM_SPREAD,
GFC_ISYM_SQRT,

21
gcc/fortran/intrinsic.c
View file

@ -2786,12 +2786,16 @@ add_functions (void)
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);
@ -2802,15 +2806,19 @@ add_functions (void)
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,
@ -4833,7 +4841,8 @@ gfc_intrinsic_func_interface (gfc_expr *expr, int error_flag)
}
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))

49
gcc/fortran/resolve.c
View file

@ -3930,6 +3930,14 @@ resolve_operator (gfc_expr *e)
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;
}
@ -3939,6 +3947,16 @@ resolve_operator (gfc_expr *e)
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))
{
@ -4092,6 +4110,36 @@ resolve_operator (gfc_expr *e)
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);
@ -6432,6 +6480,7 @@ resolve_compcall (gfc_expr* e, const char **name)
return false;
}
/* These must not be assign-calls! */
gcc_assert (!e->value.compcall.assign);

8
gcc/fortran/trans-intrinsic.c
View file

@ -9930,9 +9930,13 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr)
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;

11
gcc/testsuite/ChangeLog
View file

@ -1,3 +1,14 @@
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

26
gcc/testsuite/gfortran.dg/boz_1.f90
View file

@ -1,25 +1,25 @@
! { 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

23
gcc/testsuite/gfortran.dg/boz_3.f90
View file

@ -1,5 +1,6 @@
! { 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.
!
@ -7,18 +8,20 @@ program boz
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

24
gcc/testsuite/gfortran.dg/boz_4.f90
View file

@ -1,20 +1,16 @@
! { 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" }

7
gcc/testsuite/gfortran.dg/boz_8.f90
View file

@ -10,8 +10,9 @@
!
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

4
gcc/testsuite/gfortran.dg/dec_structure_6.f90
View file

@ -1,5 +1,5 @@
! { dg-do run }
! { dg-options "-fdec-structure" }
! { dg-options "-fdec-structure -fallow-invalid-boz" }
!
! Test old-style CLIST initializers in STRUCTURE.
!
@ -21,7 +21,7 @@ structure /s8/
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

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

@ -1,8 +1,10 @@
! { 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

6
gcc/testsuite/gfortran.dg/nan_4.f90
View file

@ -9,8 +9,8 @@
!
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