+2019-11-08 Mark Eggleston <mark.eggleston@codethink.com>
+ Jim MacArthur <jim.macarthur@codethink.co.uk>
+
+ * arith.c (hollerith2representation): Use OPT_Wcharacter_truncation in
+ call to gfc_warning. Add character2representation, gfc_character2int,
+ gfc_character2real, gfc_character2complex and gfc_character2logical.
+ * arith.h: Add prototypes for gfc_character2int, gfc_character2real,
+ gfc_character2complex and gfc_character2logical.
+ * expr.c (gfc_check_assign): Return true if left hand side is numeric
+ or logical and the right hand side is character and of kind=1.
+ * gfortran.texi: Add -fdec-char-conversions.
+ * intrinsic.c (add_conversions): Add conversions from character to
+ integer, real, complex and logical types for their supported kinds.
+ (gfc_convert_type_warn): Reorder if..else if.. sequence so that warnings
+ are produced for conversion to logical.
+ * invoke.texi: Add option to list of options.
+ * invoke.texi: Add Character conversion subsection to Extensions
+ section.
+ * lang.opt: Add new option.
+ * options.c (set_dec_flags): Add SET_BITFLAG for
+ flag_dec_char_conversions.
+ * resolve.c (resolve_ordindary_assign): Issue error if the left hand
+ side is numeric or logical and the right hand side is a character
+ variable.
+ * simplify.c (gfc_convert_constant): Assign the conversion function
+ depending on destination type.
+ * trans-const.c (gfc_constant_to_tree): Use OPT_Wsurprising in
+ gfc_warning allowing the warning to be switched off only if
+ flag_dec_char_conversions is enabled.
+
2019-11-08 Tobias Burnus <tobias@codesourcery.com
PR fortran/91253
if (src_len > result_len)
{
- gfc_warning (0,
- "The Hollerith constant at %L is too long to convert to %qs",
- &src->where, gfc_typename(&result->ts));
+ gfc_warning (OPT_Wcharacter_truncation, "The Hollerith constant at %L "
+ "is truncated in conversion to %qs", &src->where,
+ gfc_typename(&result->ts));
}
result->representation.string = XCNEWVEC (char, result_len + 1);
}
+/* Helper function to set the representation in a character conversion.
+ This assumes that the ts.type and ts.kind of the result have already
+ been set. */
+
+static void
+character2representation (gfc_expr *result, gfc_expr *src)
+{
+ size_t src_len, result_len;
+ int i;
+ src_len = src->value.character.length;
+ gfc_target_expr_size (result, &result_len);
+
+ if (src_len > result_len)
+ gfc_warning (OPT_Wcharacter_truncation, "The character constant at %L is "
+ "truncated in conversion to %s", &src->where,
+ gfc_typename(&result->ts));
+
+ result->representation.string = XCNEWVEC (char, result_len + 1);
+
+ for (i = 0; i < MIN (result_len, src_len); i++)
+ result->representation.string[i] = (char) src->value.character.string[i];
+
+ if (src_len < result_len)
+ memset (&result->representation.string[src_len], ' ',
+ result_len - src_len);
+
+ result->representation.string[result_len] = '\0'; /* For debugger. */
+ result->representation.length = result_len;
+}
+
/* Convert Hollerith to integer. The constant will be padded or truncated. */
gfc_expr *
return result;
}
+/* Convert character to integer. The constant will be padded or truncated. */
+
+gfc_expr *
+gfc_character2int (gfc_expr *src, int kind)
+{
+ gfc_expr *result;
+ result = gfc_get_constant_expr (BT_INTEGER, kind, &src->where);
+
+ character2representation (result, src);
+ gfc_interpret_integer (kind, (unsigned char *) result->representation.string,
+ result->representation.length, result->value.integer);
+ return result;
+}
-/* Convert Hollerith to real. The constant will be padded or truncated. */
+/* Convert Hollerith to real. The constant will be padded or truncated. */
gfc_expr *
gfc_hollerith2real (gfc_expr *src, int kind)
return result;
}
+/* Convert character to real. The constant will be padded or truncated. */
+
+gfc_expr *
+gfc_character2real (gfc_expr *src, int kind)
+{
+ gfc_expr *result;
+ result = gfc_get_constant_expr (BT_REAL, kind, &src->where);
+
+ character2representation (result, src);
+ gfc_interpret_float (kind, (unsigned char *) result->representation.string,
+ result->representation.length, result->value.real);
+
+ return result;
+}
+
/* Convert Hollerith to complex. The constant will be padded or truncated. */
return result;
}
+/* Convert character to complex. The constant will be padded or truncated. */
+
+gfc_expr *
+gfc_character2complex (gfc_expr *src, int kind)
+{
+ gfc_expr *result;
+ result = gfc_get_constant_expr (BT_COMPLEX, kind, &src->where);
+
+ character2representation (result, src);
+ gfc_interpret_complex (kind, (unsigned char *) result->representation.string,
+ result->representation.length, result->value.complex);
+
+ return result;
+}
+
/* Convert Hollerith to character. */
return result;
}
+
+/* Convert character to logical. The constant will be padded or truncated. */
+
+gfc_expr *
+gfc_character2logical (gfc_expr *src, int kind)
+{
+ gfc_expr *result;
+ result = gfc_get_constant_expr (BT_LOGICAL, kind, &src->where);
+
+ character2representation (result, src);
+ gfc_interpret_logical (kind, (unsigned char *) result->representation.string,
+ result->representation.length, &result->value.logical);
+
+ return result;
+}
gfc_expr *gfc_hollerith2complex (gfc_expr *, int);
gfc_expr *gfc_hollerith2character (gfc_expr *, int);
gfc_expr *gfc_hollerith2logical (gfc_expr *, int);
+gfc_expr *gfc_character2int (gfc_expr *, int);
+gfc_expr *gfc_character2real (gfc_expr *, int);
+gfc_expr *gfc_character2complex (gfc_expr *, int);
gfc_expr *gfc_character2character (gfc_expr *, int);
+gfc_expr *gfc_character2logical (gfc_expr *, int);
#endif /* GFC_ARITH_H */
|| rvalue->ts.type == BT_HOLLERITH)
return true;
+ if (flag_dec_char_conversions && (gfc_numeric_ts (&lvalue->ts)
+ || lvalue->ts.type == BT_LOGICAL)
+ && rvalue->ts.type == BT_CHARACTER
+ && rvalue->ts.kind == gfc_default_character_kind)
+ return true;
+
if (lvalue->ts.type == BT_LOGICAL && rvalue->ts.type == BT_LOGICAL)
return true;
* Unary operators::
* Implicitly convert LOGICAL and INTEGER values::
* Hollerith constants support::
+* Character conversion::
* Cray pointers::
* CONVERT specifier::
* OpenMP::
@end smallexample
+@node Character conversion
+@subsection Character conversion
+@cindex conversion, to character
+
+Allowing character literals to be used in a similar way to Hollerith constants
+is a non-standard extension. This feature is enabled using
+-fdec-char-conversions and only applies to character literals of @code{kind=1}.
+
+Character literals can be used in @code{DATA} statements and assignments with
+numeric (@code{INTEGER}, @code{REAL}, or @code{COMPLEX}) or @code{LOGICAL}
+variables. Like Hollerith constants they are copied byte-wise fashion. The
+constant will be padded with spaces or truncated to fit the size of the
+variable in which it is stored.
+
+Examples:
+@smallexample
+ integer*4 x
+ data x / 'abcd' /
+
+ x = 'A' ! Will be padded.
+ x = 'ab1234' ! Will be truncated.
+@end smallexample
+
+
@node Cray pointers
@subsection Cray pointers
@cindex pointer, Cray
add_conv (BT_LOGICAL, gfc_logical_kinds[j].kind,
BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_LEGACY);
}
+
+ /* DEC legacy feature allows character conversions similar to Hollerith
+ conversions - the character data will transferred on a byte by byte
+ basis. */
+ if (flag_dec_char_conversions)
+ {
+ /* Character-Integer conversions. */
+ for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
+ add_conv (BT_CHARACTER, gfc_default_character_kind,
+ BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_LEGACY);
+ /* Character-Real conversions. */
+ for (i = 0; gfc_real_kinds[i].kind != 0; i++)
+ add_conv (BT_CHARACTER, gfc_default_character_kind,
+ BT_REAL, gfc_real_kinds[i].kind, GFC_STD_LEGACY);
+ /* Character-Complex conversions. */
+ for (i = 0; gfc_real_kinds[i].kind != 0; i++)
+ add_conv (BT_CHARACTER, gfc_default_character_kind,
+ BT_COMPLEX, gfc_real_kinds[i].kind, GFC_STD_LEGACY);
+ /* Character-Logical conversions. */
+ for (i = 0; gfc_logical_kinds[i].kind != 0; i++)
+ add_conv (BT_CHARACTER, gfc_default_character_kind,
+ BT_LOGICAL, gfc_logical_kinds[i].kind, GFC_STD_LEGACY);
+ }
}
/* At this point, a conversion is necessary. A warning may be needed. */
if ((gfc_option.warn_std & sym->standard) != 0)
{
+ const char *type_name = is_char_constant ? gfc_typename (expr)
+ : gfc_typename (&from_ts);
gfc_warning_now (0, "Extension: Conversion from %s to %s at %L",
- gfc_typename (&from_ts), gfc_dummy_typename (ts),
+ type_name, gfc_dummy_typename (ts),
&expr->where);
}
else if (wflag)
If range checking was disabled, but -Wconversion enabled,
a non range checked warning is generated below. */
}
- else if (from_ts.type == BT_LOGICAL || ts->type == BT_LOGICAL)
+ else if (flag_dec_char_conversions && from_ts.type == BT_CHARACTER
+ && (gfc_numeric_ts (ts) || ts->type == BT_LOGICAL))
{
- /* Do nothing. This block exists only to simplify the other
- else-if expressions.
- LOGICAL <> LOGICAL no warning, independent of kind values
- LOGICAL <> INTEGER extension, warned elsewhere
- LOGICAL <> REAL invalid, error generated elsewhere
- LOGICAL <> COMPLEX invalid, error generated elsewhere */
+ const char *type_name = is_char_constant ? gfc_typename (expr)
+ : gfc_typename (&from_ts);
+ gfc_warning_now (OPT_Wconversion, "Nonstandard conversion from %s "
+ "to %s at %L", type_name, gfc_typename (ts),
+ &expr->where);
}
else if (from_ts.type == ts->type
|| (from_ts.type == BT_INTEGER && ts->type == BT_REAL)
"conversion from %s to %s at %L",
gfc_typename (&from_ts), gfc_typename (ts),
&expr->where);
- else if (warn_conversion_extra)
+ else
gfc_warning_now (OPT_Wconversion_extra, "Conversion from %s to %s "
"at %L", gfc_typename (&from_ts),
gfc_typename (ts), &expr->where);
{
/* Conversion from REAL/COMPLEX to INTEGER or COMPLEX to REAL
usually comes with a loss of information, regardless of kinds. */
- if (warn_conversion && expr->expr_type != EXPR_CONSTANT)
+ if (expr->expr_type != EXPR_CONSTANT)
gfc_warning_now (OPT_Wconversion, "Possible change of value in "
"conversion from %s to %s at %L",
gfc_typename (&from_ts), gfc_typename (ts),
else if (from_ts.type == BT_HOLLERITH || ts->type == BT_HOLLERITH)
{
/* If HOLLERITH is involved, all bets are off. */
- if (warn_conversion)
- gfc_warning_now (OPT_Wconversion, "Conversion from %s to %s at %L",
- gfc_typename (&from_ts), gfc_dummy_typename (ts),
- &expr->where);
+ gfc_warning_now (OPT_Wconversion, "Conversion from %s to %s at %L",
+ gfc_typename (&from_ts), gfc_dummy_typename (ts),
+ &expr->where);
+ }
+ else if (from_ts.type == BT_LOGICAL || ts->type == BT_LOGICAL)
+ {
+ /* Do nothing. This block exists only to simplify the other
+ else-if expressions.
+ LOGICAL <> LOGICAL no warning, independent of kind values
+ LOGICAL <> INTEGER extension, warned elsewhere
+ LOGICAL <> REAL invalid, error generated elsewhere
+ LOGICAL <> COMPLEX invalid, error generated elsewhere */
}
else
- gcc_unreachable ();
+ gcc_unreachable ();
}
/* Insert a pre-resolved function call to the right function. */
}
gfc_internal_error ("Cannot convert %qs to %qs at %L", type_name,
- gfc_typename (ts),
- &expr->where);
+ gfc_typename (ts), &expr->where);
/* Not reached */
}
@xref{Fortran Dialect Options,,Options controlling Fortran dialect}.
@gccoptlist{-fall-intrinsics -fallow-argument-mismatch -fallow-invalid-boz @gol
-fbackslash -fcray-pointer -fd-lines-as-code -fd-lines-as-comments -fdec @gol
--fdec-structure-fdec-intrinsic-ints -fdec-static -fdec-math -fdec-include @gol
--fdec-format-defaults -fdec-blank-format-item -fdefault-double-8 @gol
--fdefault-integer-8 -fdefault-real-8 -fdefault-real-10 @gol
+-fdec-char-conversions -fdec-structure -fdec-intrinsic-ints -fdec-static @gol
+-fdec-math -fdec-include -fdec-format-defaults -fdec-blank-format-item @gol
+-fdefault-double-8 -fdefault-integer-8 -fdefault-real-8 -fdefault-real-10 @gol
-fdefault-real-16 -fdollar-ok -ffixed-line-length-@var{n} @gol
-ffixed-line-length-none -fpad-source -ffree-form @gol
-ffree-line-length-@var{n} -ffree-line-length-none -fimplicit-none @gol
full documentation.
Other flags enabled by this switch are:
-@option{-fdollar-ok} @option{-fcray-pointer} @option{-fdec-structure}
-@option{-fdec-intrinsic-ints} @option{-fdec-static} @option{-fdec-math}
-@option{-fdec-include} @option{-fdec-blank-format-item}
+@option{-fdollar-ok} @option{-fcray-pointer} @option{-fdec-char-conversions}
+@option{-fdec-structure} @option{-fdec-intrinsic-ints} @option{-fdec-static}
+@option{-fdec-math} @option{-fdec-include} @option{-fdec-blank-format-item}
@option{-fdec-format-defaults}
If @option{-fd-lines-as-code}/@option{-fd-lines-as-comments} are unset, then
@option{-fdec} also sets @option{-fd-lines-as-comments}.
+@item -fdec-char-conversions
+@opindex @code{fdec-char-conversions}
+Enable the use of character literals in assignments and data statements
+for non-character variables.
+
@item -fdec-structure
@opindex @code{fdec-structure}
Enable DEC @code{STRUCTURE} and @code{RECORD} as well as @code{UNION},
Fortran Var(flag_dec_blank_format_item)
Enable the use of blank format items in format strings.
+fdec-char-conversions
+Fortran Var(flag_dec_char_conversions)
+Enable the use of character literals in assignments and data statements
+for non-character variables.
+
fdec-include
Fortran Var(flag_dec_include)
Enable legacy parsing of INCLUDE as statement.
SET_BITFLAG (flag_dec_include, value, value);
SET_BITFLAG (flag_dec_format_defaults, value, value);
SET_BITFLAG (flag_dec_blank_format_item, value, value);
+ SET_BITFLAG (flag_dec_char_conversions, value, value);
}
/* Finalize DEC flags. */
lhs = code->expr1;
rhs = code->expr2;
+ if ((gfc_numeric_ts (&lhs->ts) || lhs->ts.type == BT_LOGICAL)
+ && rhs->ts.type == BT_CHARACTER
+ && rhs->expr_type != EXPR_CONSTANT)
+ {
+ /* Use of -fdec-char-conversions allows assignment of character data
+ to non-character variables. This not permited for nonconstant
+ strings. */
+ gfc_error ("Cannot convert %s to %s at %L", gfc_typename (rhs),
+ gfc_typename (lhs), &rhs->where);
+ return false;
+ }
+
/* Handle the case of a BOZ literal on the RHS. */
if (rhs->ts.type == BT_BOZ)
{
break;
case BT_CHARACTER:
- if (type == BT_CHARACTER)
- f = gfc_character2character;
- else
- goto oops;
+ switch (type)
+ {
+ case BT_INTEGER:
+ f = gfc_character2int;
+ break;
+
+ case BT_REAL:
+ f = gfc_character2real;
+ break;
+
+ case BT_COMPLEX:
+ f = gfc_character2complex;
+ break;
+
+ case BT_CHARACTER:
+ f = gfc_character2character;
+ break;
+
+ case BT_LOGICAL:
+ f = gfc_character2logical;
+ break;
+
+ default:
+ goto oops;
+ }
break;
default:
#include "coretypes.h"
#include "tree.h"
#include "gfortran.h"
+#include "options.h"
#include "trans.h"
#include "fold-const.h"
#include "stor-layout.h"
gfc_build_string_const (expr->representation.length,
expr->representation.string));
if (!integer_zerop (tmp) && !integer_onep (tmp))
- gfc_warning (0, "Assigning value other than 0 or 1 to LOGICAL"
- " has undefined result at %L", &expr->where);
+ gfc_warning (flag_dec_char_conversions ? OPT_Wsurprising : 0,
+ "Assigning value other than 0 or 1 to LOGICAL has "
+ "undefined result at %L", &expr->where);
return fold_convert (gfc_get_logical_type (expr->ts.kind), tmp);
}
else
+2019-11-08 Mark Eggleston <mark.eggleston@codethink.com>
+ Jim MacArthur <jim.macarthur@codethink.co.uk>
+
+ * gfortran.dg/dec_char_conversion_in_assignment_1.f90: New test.
+ * gfortran.dg/dec_char_conversion_in_assignment_2.f90: New test.
+ * gfortran.dg/dec_char_conversion_in_assignment_3.f90: New test.
+ * gfortran.dg/dec_char_conversion_in_assignment_4.f90: New test.
+ * gfortran.dg/dec_char_conversion_in_assignment_5.f90: New test.
+ * gfortran.dg/dec_char_conversion_in_assignment_6.f90: New test.
+ * gfortran.dg/dec_char_conversion_in_assignment_7.f90: New test.
+ * gfortran.dg/dec_char_conversion_in_assignment_8.f90: New test.
+ * gfortran.dg/dec_char_conversion_in_data_1.f90: New test.
+ * gfortran.dg/dec_char_conversion_in_data_2.f90: New test.
+ * gfortran.dg/dec_char_conversion_in_data_3.f90: New test.
+ * gfortran.dg/dec_char_conversion_in_data_4.f90: New test.
+ * gfortran.dg/dec_char_conversion_in_data_5.f90: New test.
+ * gfortran.dg/dec_char_conversion_in_data_6.f90: New test.
+ * gfortran.dg/dec_char_conversion_in_data_7.f90: New test.
+ * gfortran.dg/hollerith5.f90: Add -Wsurprising to options.
+ * gfortran.dg/hollerith_legacy.f90: Add -Wsurprising to options.
+ * gfortran.dg/no_char_to_numeric_assign.f90: New test.
+
2019-11-08 Andre Vieira <andre.simoesdiasvieira@arm.com>
PR tree-optimization/92351
--- /dev/null
+! { dg-do run }
+! { dg-options "-fdec" }
+!
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
+!
+program test
+ integer(4) :: a
+ real(4) :: b
+ complex(4) :: c
+ logical(4) :: d
+ integer(4) :: e
+ real(4) :: f
+ complex(4) :: g
+ logical(4) :: h
+
+ a = '1234'
+ b = '1234'
+ c = '12341234'
+ d = '1234'
+ e = 4h1234
+ f = 4h1234
+ g = 8h12341234
+ h = 4h1234
+
+ if (a.ne.e) stop 1
+ if (b.ne.f) stop 2
+ if (c.ne.g) stop 3
+ if (d.neqv.h) stop 4
+
+ ! padded values
+ a = '12'
+ b = '12'
+ c = '12234'
+ d = '124'
+ e = 2h12
+ f = 2h12
+ g = 5h12234
+ h = 3h123
+
+ if (a.ne.e) stop 5
+ if (b.ne.f) stop 6
+ if (c.ne.g) stop 7
+ if (d.neqv.h) stop 8
+
+ ! truncated values
+ a = '123478'
+ b = '123478'
+ c = '12341234987'
+ d = '1234abc'
+ e = 6h123478
+ f = 6h123478
+ g = 11h12341234987
+ h = 7h1234abc
+
+ if (a.ne.e) stop 5
+ if (b.ne.f) stop 6
+ if (c.ne.g) stop 7
+ if (d.neqv.h) stop 8
+
+end program
+
--- /dev/null
+! { dg-do run }
+! { dg-options "-fdec -Wconversion" }
+!
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
+!
+include "dec_char_conversion_in_assignment_1.f90"
+
+! { dg-warning "Nonstandard conversion from CHARACTER" " " { target *-*-* } 16 }
+! { dg-warning "Nonstandard conversion from CHARACTER" " " { target *-*-* } 17 }
+! { dg-warning "Nonstandard conversion from CHARACTER" " " { target *-*-* } 18 }
+! { dg-warning "Nonstandard conversion from CHARACTER" " " { target *-*-* } 19 }
+! { dg-warning "Conversion from HOLLERITH" " " { target *-*-* } 20 }
+! { dg-warning "Conversion from HOLLERITH" " " { target *-*-* } 21 }
+! { dg-warning "Conversion from HOLLERITH" " " { target *-*-* } 22 }
+! { dg-warning "Conversion from HOLLERITH" " " { target *-*-* } 23 }
+! { dg-warning "Nonstandard conversion from CHARACTER" " " { target *-*-* } 31 }
+! { dg-warning "Nonstandard conversion from CHARACTER" " " { target *-*-* } 32 }
+! { dg-warning "Nonstandard conversion from CHARACTER" " " { target *-*-* } 33 }
+! { dg-warning "Nonstandard conversion from CHARACTER" " " { target *-*-* } 34 }
+! { dg-warning "Conversion from HOLLERITH" " " { target *-*-* } 35 }
+! { dg-warning "Conversion from HOLLERITH" " " { target *-*-* } 36 }
+! { dg-warning "Conversion from HOLLERITH" " " { target *-*-* } 37 }
+! { dg-warning "Conversion from HOLLERITH" " " { target *-*-* } 38 }
+! { dg-warning "Nonstandard conversion from CHARACTER" " " { target *-*-* } 46 }
+! { dg-warning "Nonstandard conversion from CHARACTER" " " { target *-*-* } 47 }
+! { dg-warning "Nonstandard conversion from CHARACTER" " " { target *-*-* } 48 }
+! { dg-warning "Nonstandard conversion from CHARACTER" " " { target *-*-* } 49 }
+! { dg-warning "Conversion from HOLLERITH" " " { target *-*-* } 50 }
+! { dg-warning "Conversion from HOLLERITH" " " { target *-*-* } 51 }
+! { dg-warning "Conversion from HOLLERITH" " " { target *-*-* } 52 }
+! { dg-warning "Conversion from HOLLERITH" " " { target *-*-* } 53 }
--- /dev/null
+! { dg-do run }
+! { dg-options "-fdec-char-conversions" }
+!
+! Contributeds by Mark Eggleston <mark.eggleston@codethink.com>
+!
+include "dec_char_conversion_in_assignment_1.f90"
+
+! { dg-warning "Extension: Conversion from CHARACTER" " " { target *-*-* } 16 }
+! { dg-warning "Extension: Conversion from CHARACTER" " " { target *-*-* } 17 }
+! { dg-warning "Extension: Conversion from CHARACTER" " " { target *-*-* } 18 }
+! { dg-warning "Extension: Conversion from CHARACTER" " " { target *-*-* } 19 }
+! { dg-warning "Extension: Hollerith constant" " " { target *-*-* } 20 }
+! { dg-warning "Extension: Hollerith constant" " " { target *-*-* } 21 }
+! { dg-warning "Extension: Hollerith constant" " " { target *-*-* } 22 }
+! { dg-warning "Extension: Hollerith constant" " " { target *-*-* } 23 }
+! { dg-warning "Extension: Conversion from HOLLERITH" " " { target *-*-* } 20 }
+! { dg-warning "Extension: Conversion from HOLLERITH" " " { target *-*-* } 21 }
+! { dg-warning "Extension: Conversion from HOLLERITH" " " { target *-*-* } 22 }
+! { dg-warning "Extension: Conversion from HOLLERITH" " " { target *-*-* } 23 }
+! { dg-warning "Extension: Conversion from CHARACTER" " " { target *-*-* } 31 }
+! { dg-warning "Extension: Conversion from CHARACTER" " " { target *-*-* } 32 }
+! { dg-warning "Extension: Conversion from CHARACTER" " " { target *-*-* } 33 }
+! { dg-warning "Extension: Conversion from CHARACTER" " " { target *-*-* } 34 }
+! { dg-warning "Extension: Hollerith constant" " " { target *-*-* } 35 }
+! { dg-warning "Extension: Hollerith constant" " " { target *-*-* } 36 }
+! { dg-warning "Extension: Hollerith constant" " " { target *-*-* } 37 }
+! { dg-warning "Extension: Hollerith constant" " " { target *-*-* } 38 }
+! { dg-warning "Extension: Conversion from HOLLERITH" " " { target *-*-* } 35 }
+! { dg-warning "Extension: Conversion from HOLLERITH" " " { target *-*-* } 36 }
+! { dg-warning "Extension: Conversion from HOLLERITH" " " { target *-*-* } 37 }
+! { dg-warning "Extension: Conversion from HOLLERITH" " " { target *-*-* } 38 }
+! { dg-warning "Extension: Conversion from CHARACTER" " " { target *-*-* } 46 }
+! { dg-warning "Extension: Conversion from CHARACTER" " " { target *-*-* } 47 }
+! { dg-warning "Extension: Conversion from CHARACTER" " " { target *-*-* } 48 }
+! { dg-warning "Extension: Conversion from CHARACTER" " " { target *-*-* } 49 }
+! { dg-warning "Extension: Hollerith constant" " " { target *-*-* } 50 }
+! { dg-warning "Extension: Hollerith constant" " " { target *-*-* } 51 }
+! { dg-warning "Extension: Hollerith constant" " " { target *-*-* } 52 }
+! { dg-warning "Extension: Hollerith constant" " " { target *-*-* } 53 }
+! { dg-warning "Extension: Conversion from HOLLERITH" " " { target *-*-* } 50 }
+! { dg-warning "Extension: Conversion from HOLLERITH" " " { target *-*-* } 51 }
+! { dg-warning "Extension: Conversion from HOLLERITH" " " { target *-*-* } 52 }
+! { dg-warning "Extension: Conversion from HOLLERITH" " " { target *-*-* } 53 }
+
--- /dev/null
+! { dg-do run }
+! { dg-options "-fdec -fno-dec-char-conversions" }
+!
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
+!
+include "dec_char_conversion_in_assignment_1.f90"
+
+! { dg-error "Cannot convert" " " { target *-*-* } 16 }
+! { dg-error "Cannot convert" " " { target *-*-* } 17 }
+! { dg-error "Cannot convert" " " { target *-*-* } 18 }
+! { dg-error "Cannot convert" " " { target *-*-* } 19 }
+! { dg-error "Cannot convert" " " { target *-*-* } 31 }
+! { dg-error "Cannot convert" " " { target *-*-* } 32 }
+! { dg-error "Cannot convert" " " { target *-*-* } 33 }
+! { dg-error "Cannot convert" " " { target *-*-* } 34 }
+! { dg-error "Cannot convert" " " { target *-*-* } 46 }
+! { dg-error "Cannot convert" " " { target *-*-* } 47 }
+! { dg-error "Cannot convert" " " { target *-*-* } 48 }
+! { dg-error "Cannot convert" " " { target *-*-* } 49 }
+
--- /dev/null
+! { dg-do run }
+! { dg-options "-fdec -Wcharacter-truncation" }
+!
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
+!
+include "dec_char_conversion_in_assignment_1.f90"
+
+! { dg-warning "is truncated in conversion" " " { target *-*-* } 46 }
+! { dg-warning "is truncated in conversion" " " { target *-*-* } 47 }
+! { dg-warning "is truncated in conversion" " " { target *-*-* } 48 }
+! { dg-warning "is truncated in conversion" " " { target *-*-* } 49 }
+! { dg-warning "is truncated in conversion" " " { target *-*-* } 50 }
+! { dg-warning "is truncated in conversion" " " { target *-*-* } 51 }
+! { dg-warning "is truncated in conversion" " " { target *-*-* } 52 }
+! { dg-warning "is truncated in conversion" " " { target *-*-* } 53 }
+
--- /dev/null
+! { dg-do run }
+! { dg-options "-fdec -Wsurprising" }
+!
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
+!
+include "dec_char_conversion_in_assignment_1.f90"
+
+! { dg-warning "Assigning value other than 0 or 1 to LOGICAL" " " { target *-*-* } 19 }
+! { dg-warning "Assigning value other than 0 or 1 to LOGICAL" " " { target *-*-* } 23 }
+! { dg-warning "Assigning value other than 0 or 1 to LOGICAL" " " { target *-*-* } 34 }
+! { dg-warning "Assigning value other than 0 or 1 to LOGICAL" " " { target *-*-* } 38 }
+! { dg-warning "Assigning value other than 0 or 1 to LOGICAL" " " { target *-*-* } 49 }
+! { dg-warning "Assigning value other than 0 or 1 to LOGICAL" " " { target *-*-* } 53 }
+
--- /dev/null
+! { dg-do run }
+! { dg-options "-fdec -Wconversion -Wcharacter-truncation" }
+!
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
+!
+program test
+ integer(4), parameter :: a = '1234'
+ real(4), parameter :: b = '12'
+ complex(4), parameter :: c = '12341234'
+ logical(4), parameter :: d = 'abcd'
+ integer(4), parameter :: e = 4h1234
+ real(4), parameter :: f = 2h12
+ complex(4), parameter :: g = 8h12341234
+ logical(4), parameter :: h = 4habcd
+
+ if (a.ne.e) stop 1
+ if (b.ne.f) stop 2
+ if (c.ne.g) stop 3
+ if (d.neqv.h) stop 4
+end program
+
+! { dg-warning "Nonstandard conversion from CHARACTER" " " { target *-*-* } 7 }
+! { dg-warning "Nonstandard conversion from CHARACTER" " " { target *-*-* } 8 }
+! { dg-warning "Nonstandard conversion from CHARACTER" " " { target *-*-* } 9 }
+! { dg-warning "Nonstandard conversion from CHARACTER" " " { target *-*-* } 10 }
+! { dg-warning "Conversion from HOLLERITH to INTEGER" " " { target *-*-* } 11 }
+! { dg-warning "Conversion from HOLLERITH to REAL" " " { target *-*-* } 12 }
+! { dg-warning "Conversion from HOLLERITH to COMPLEX" " " { target *-*-* } 13 }
+! { dg-warning "Conversion from HOLLERITH to LOGICAL" " " { target *-*-* } 14 }
+
--- /dev/null
+! { dg-do compile }
+! { dg-options "-fdec" }
+!
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
+!
+program test
+ integer(4) :: a
+ real(4) :: b
+ complex(4) :: c
+ logical(4) :: d
+
+ a = 4_'1234' ! { dg-error "Cannot convert CHARACTER\\(4,4\\) to" }
+ b = 4_'12' ! { dg-error "Cannot convert CHARACTER\\(2,4\\) to" }
+ c = 4_'12341234' ! { dg-error "Cannot convert CHARACTER\\(8,4\\) to" }
+ d = 4_'abcd' ! { dg-error "Cannot convert CHARACTER\\(4,4\\) to" }
+end program
+
--- /dev/null
+! { dg-do run }
+! { dg-options "-fdec" }
+!
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
+!
+
+subroutine normal
+ integer(4) :: a
+ real(4) :: b
+ complex(4) :: c
+ logical(4) :: d
+ integer(4) :: e
+ real(4) :: f
+ complex(4) :: g
+ logical(4) :: h
+
+ data a / '1234' /
+ data b / '1234' /
+ data c / '12341234' / ! double the length for complex
+ data d / '1234' /
+ data e / 4h1234 /
+ data f / 4h1234 /
+ data g / 8h12341234 / ! double the length for complex
+ data h / 4h1234 /
+
+ if (a.ne.e) stop 1
+ if (b.ne.f) stop 2
+ if (c.ne.g) stop 3
+ if (d.neqv.h) stop 4
+end subroutine
+
+subroutine padded
+ integer(4) :: a
+ real(4) :: b
+ complex(4) :: c
+ logical(4) :: d
+ integer(4) :: e
+ real(4) :: f
+ complex(4) :: g
+ logical(4) :: h
+
+ data a / '12' /
+ data b / '12' /
+ data c / '12334' /
+ data d / '123' /
+ data e / 2h12 /
+ data f / 2h12 /
+ data g / 5h12334 /
+ data h / 3h123 /
+
+ if (a.ne.e) stop 5
+ if (b.ne.f) stop 6
+ if (c.ne.g) stop 7
+ if (d.neqv.h) stop 8
+end subroutine
+
+subroutine truncated
+ integer(4) :: a
+ real(4) :: b
+ complex(4) :: c
+ logical(4) :: d
+ integer(4) :: e
+ real(4) :: f
+ complex(4) :: g
+ logical(4) :: h
+
+ data a / '123478' /
+ data b / '123478' /
+ data c / '1234123498' /
+ data d / '12345' /
+ data e / 6h123478 /
+ data f / 6h123478 /
+ data g / 10h1234123498 /
+ data h / 5h12345 /
+
+ if (a.ne.e) stop 9
+ if (b.ne.f) stop 10
+ if (c.ne.g) stop 11
+ if (d.neqv.h) stop 12
+end subroutine
+
+program test
+ call normal
+ call padded
+ call truncated
+end program
+
--- /dev/null
+! { dg-do run }
+! { dg-options "-fdec-char-conversions" }
+!
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
+!
+include "dec_char_conversion_in_data_1.f90"
+
+! { dg-warning "Legacy Extension: Hollerith constant" " " { target *-*-* } 21 }
+! { dg-warning "Legacy Extension: Hollerith constant" " " { target *-*-* } 22 }
+! { dg-warning "Legacy Extension: Hollerith constant" " " { target *-*-* } 23 }
+! { dg-warning "Legacy Extension: Hollerith constant" " " { target *-*-* } 24 }
+! { dg-warning "Legacy Extension: Hollerith constant" " " { target *-*-* } 46 }
+! { dg-warning "Legacy Extension: Hollerith constant" " " { target *-*-* } 47 }
+! { dg-warning "Legacy Extension: Hollerith constant" " " { target *-*-* } 48 }
+! { dg-warning "Legacy Extension: Hollerith constant" " " { target *-*-* } 49 }
+! { dg-warning "Legacy Extension: Hollerith constant" " " { target *-*-* } 71 }
+! { dg-warning "Legacy Extension: Hollerith constant" " " { target *-*-* } 72 }
+! { dg-warning "Legacy Extension: Hollerith constant" " " { target *-*-* } 73 }
+! { dg-warning "Legacy Extension: Hollerith constant" " " { target *-*-* } 74 }
+! { dg-warning "Extension: Conversion from HOLLERITH" " " { target *-*-* } 21 }
+! { dg-warning "Extension: Conversion from HOLLERITH" " " { target *-*-* } 22 }
+! { dg-warning "Extension: Conversion from HOLLERITH" " " { target *-*-* } 23 }
+! { dg-warning "Extension: Conversion from HOLLERITH" " " { target *-*-* } 24 }
+! { dg-warning "Extension: Conversion from HOLLERITH" " " { target *-*-* } 46 }
+! { dg-warning "Extension: Conversion from HOLLERITH" " " { target *-*-* } 47 }
+! { dg-warning "Extension: Conversion from HOLLERITH" " " { target *-*-* } 48 }
+! { dg-warning "Extension: Conversion from HOLLERITH" " " { target *-*-* } 49 }
+! { dg-warning "Extension: Conversion from HOLLERITH" " " { target *-*-* } 71 }
+! { dg-warning "Extension: Conversion from HOLLERITH" " " { target *-*-* } 72 }
+! { dg-warning "Extension: Conversion from HOLLERITH" " " { target *-*-* } 73 }
+! { dg-warning "Extension: Conversion from HOLLERITH" " " { target *-*-* } 74 }
+! { dg-warning "Extension: Conversion from CHARACTER\\(4\\)" " " { target *-*-* } 17 }
+! { dg-warning "Extension: Conversion from CHARACTER\\(4\\)" " " { target *-*-* } 18 }
+! { dg-warning "Extension: Conversion from CHARACTER\\(8\\)" " " { target *-*-* } 19 }
+! { dg-warning "Extension: Conversion from CHARACTER\\(4\\)" " " { target *-*-* } 20 }
+! { dg-warning "Extension: Conversion from CHARACTER\\(2\\)" " " { target *-*-* } 42 }
+! { dg-warning "Extension: Conversion from CHARACTER\\(2\\)" " " { target *-*-* } 43 }
+! { dg-warning "Extension: Conversion from CHARACTER\\(5\\)" " " { target *-*-* } 44 }
+! { dg-warning "Extension: Conversion from CHARACTER\\(3\\)" " " { target *-*-* } 45 }
+! { dg-warning "Extension: Conversion from CHARACTER\\(6\\)" " " { target *-*-* } 67 }
+! { dg-warning "Extension: Conversion from CHARACTER\\(6\\)" " " { target *-*-* } 68 }
+! { dg-warning "Extension: Conversion from CHARACTER\\(10\\)" " " { target *-*-* } 69 }
+! { dg-warning "Extension: Conversion from CHARACTER\\(5\\)" " " { target *-*-* } 70 }
+
+
--- /dev/null
+! { dg-do run }
+! { dg-options "-fdec -fno-dec-char-conversions" }
+!
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
+!
+include "dec_char_conversion_in_data_1.f90"
+
+! { dg-error "Incompatible types" " " { target *-*-* } 17 }
+! { dg-error "Incompatible types" " " { target *-*-* } 18 }
+! { dg-error "Incompatible types" " " { target *-*-* } 19 }
+! { dg-error "Incompatible types" " " { target *-*-* } 20 }
+! { dg-error "Incompatible types" " " { target *-*-* } 42 }
+! { dg-error "Incompatible types" " " { target *-*-* } 43 }
+! { dg-error "Incompatible types" " " { target *-*-* } 44 }
+! { dg-error "Incompatible types" " " { target *-*-* } 45 }
+! { dg-error "Incompatible types" " " { target *-*-* } 67 }
+! { dg-error "Incompatible types" " " { target *-*-* } 68 }
+! { dg-error "Incompatible types" " " { target *-*-* } 69 }
+! { dg-error "Incompatible types" " " { target *-*-* } 70 }
+
--- /dev/null
+! { dg-do run }
+! { dg-options "-fdec -Wcharacter-truncation" }
+!
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
+!
+include "dec_char_conversion_in_data_1.f90"
+
+! { dg-warning "character constant at \\(1\\) is truncated in conversion" " " { target *-*-* } 67 }
+! { dg-warning "character constant at \\(1\\) is truncated in conversion" " " { target *-*-* } 68 }
+! { dg-warning "character constant at \\(1\\) is truncated in conversion" " " { target *-*-* } 69 }
+! { dg-warning "character constant at \\(1\\) is truncated in conversion" " " { target *-*-* } 70 }
+! { dg-warning "Hollerith constant at \\(1\\) is truncated in conversion" " " { target *-*-* } 71 }
+! { dg-warning "Hollerith constant at \\(1\\) is truncated in conversion" " " { target *-*-* } 72 }
+! { dg-warning "Hollerith constant at \\(1\\) is truncated in conversion" " " { target *-*-* } 73 }
+! { dg-warning "Hollerith constant at \\(1\\) is truncated in conversion" " " { target *-*-* } 74 }
+
+
--- /dev/null
+! { dg-do run }
+! { dg-options "-fdec -Wsurprising" }
+!
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
+!
+include "dec_char_conversion_in_data_1.f90"
+
+! { dg-warning "Assigning value other than 0 or 1 to LOGICAL" " " { target *-*-* } 20 }
+! { dg-warning "Assigning value other than 0 or 1 to LOGICAL" " " { target *-*-* } 24 }
+! { dg-warning "Assigning value other than 0 or 1 to LOGICAL" " " { target *-*-* } 45 }
+! { dg-warning "Assigning value other than 0 or 1 to LOGICAL" " " { target *-*-* } 49 }
+! { dg-warning "Assigning value other than 0 or 1 to LOGICAL" " " { target *-*-* } 70 }
+! { dg-warning "Assigning value other than 0 or 1 to LOGICAL" " " { target *-*-* } 74 }
+
+
--- /dev/null
+! { dg-do run }
+! { dg-options "-fdec -Wconversion" }
+!
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
+!
+include "dec_char_conversion_in_data_1.f90"
+
+! { dg-warning "Nonstandard conversion from CHARACTER\\(4\\)" " " { target *-*-* } 17 }
+! { dg-warning "Nonstandard conversion from CHARACTER\\(4\\)" " " { target *-*-* } 18 }
+! { dg-warning "Nonstandard conversion from CHARACTER\\(8\\)" " " { target *-*-* } 19 }
+! { dg-warning "Nonstandard conversion from CHARACTER\\(4\\)" " " { target *-*-* } 20 }
+! { dg-warning "Conversion from HOLLERITH" " " { target *-*-* } 21 }
+! { dg-warning "Conversion from HOLLERITH" " " { target *-*-* } 22 }
+! { dg-warning "Conversion from HOLLERITH" " " { target *-*-* } 23 }
+! { dg-warning "Conversion from HOLLERITH" " " { target *-*-* } 24 }
+! { dg-warning "Nonstandard conversion from CHARACTER\\(2\\)" " " { target *-*-* } 42 }
+! { dg-warning "Nonstandard conversion from CHARACTER\\(2\\)" " " { target *-*-* } 43 }
+! { dg-warning "Nonstandard conversion from CHARACTER\\(5\\)" " " { target *-*-* } 44 }
+! { dg-warning "Nonstandard conversion from CHARACTER\\(3\\)" " " { target *-*-* } 45 }
+! { dg-warning "Conversion from HOLLERITH" " " { target *-*-* } 46 }
+! { dg-warning "Conversion from HOLLERITH" " " { target *-*-* } 47 }
+! { dg-warning "Conversion from HOLLERITH" " " { target *-*-* } 48 }
+! { dg-warning "Conversion from HOLLERITH" " " { target *-*-* } 49 }
+! { dg-warning "Nonstandard conversion from CHARACTER\\(6\\)" " " { target *-*-* } 67 }
+! { dg-warning "Nonstandard conversion from CHARACTER\\(6\\)" " " { target *-*-* } 68 }
+! { dg-warning "Nonstandard conversion from CHARACTER\\(10\\)" " " { target *-*-* } 69 }
+! { dg-warning "Nonstandard conversion from CHARACTER\\(5\\)" " " { target *-*-* } 70 }
+! { dg-warning "Conversion from HOLLERITH" " " { target *-*-* } 71 }
+! { dg-warning "Conversion from HOLLERITH" " " { target *-*-* } 72 }
+! { dg-warning "Conversion from HOLLERITH" " " { target *-*-* } 73 }
+! { dg-warning "Conversion from HOLLERITH" " " { target *-*-* } 74 }
+
+
--- /dev/null
+! { dg-do compile }
+! { dg-options "-fdec" }
+!
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
+!
+program test
+ integer(4) :: a
+ real(4) :: b
+ complex(4) :: c
+ logical(4) :: d
+
+ data a / 4_'1234' / ! { dg-error "attempted conversion of CHARACTER\\(4,4\\)" }
+ data b / 4_'12' / ! { dg-error "attempted conversion of CHARACTER\\(2,4\\)" }
+ data c / 4_'12341234' / ! { dg-error "attempted conversion of CHARACTER\\(8,4\\)" }
+ data d / 4_'abcd' / ! { dg-error "attempted conversion of CHARACTER\\(4,4\\)" }
+end program
+
! { dg-do compile }
+ ! { dg-options "-Wsurprising" }
implicit none
logical b
b = 4Habcd ! { dg-warning "has undefined result" }
end
-! { dg-warning "Hollerith constant" "const" { target *-*-* } 4 }
-! { dg-warning "Conversion" "conversion" { target *-*-* } 4 }
+! { dg-warning "Hollerith constant" "const" { target *-*-* } 5 }
+! { dg-warning "Conversion" "conversion" { target *-*-* } 5 }
! { dg-do compile }
-! { dg-options "-std=legacy" }
+! { dg-options "-std=legacy -Wsurprising" }
! PR15966, PR18781 & PR16531
implicit none
complex(kind=8) x(2)
--- /dev/null
+! { dg-do compile }
+! { dg-options "-fdec-char-conversions" }
+!
+! Test character variables can not be assigned to numeric and
+! logical variables.
+!
+! Test case contributed by Mark Eggleston <mark.eggleston@codethink.com>
+!
+program test
+ integer a
+ real b
+ complex c
+ logical d
+ character e
+
+ e = "A"
+ a = e ! { dg-error "Cannot convert" }
+ b = e ! { dg-error "Cannot convert" }
+ c = e ! { dg-error "Cannot convert" }
+ d = e ! { dg-error "Cannot convert" }
+end program
projects / platform / upstream / gcc.git / commitdiff