diff options
Diffstat (limited to 'gcc/fortran')
| -rw-r--r-- | gcc/fortran/ChangeLog | 30 | ||||
| -rw-r--r-- | gcc/fortran/arith.c | 96 | ||||
| -rw-r--r-- | gcc/fortran/arith.h | 4 | ||||
| -rw-r--r-- | gcc/fortran/expr.c | 6 | ||||
| -rw-r--r-- | gcc/fortran/gfortran.texi | 25 | ||||
| -rw-r--r-- | gcc/fortran/intrinsic.c | 66 | ||||
| -rw-r--r-- | gcc/fortran/invoke.texi | 17 | ||||
| -rw-r--r-- | gcc/fortran/lang.opt | 5 | ||||
| -rw-r--r-- | gcc/fortran/options.c | 1 | ||||
| -rw-r--r-- | gcc/fortran/resolve.c | 12 | ||||
| -rw-r--r-- | gcc/fortran/simplify.c | 29 | ||||
| -rw-r--r-- | gcc/fortran/trans-const.c | 6 |
12 files changed, 264 insertions, 33 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index f13444f..18e4c02 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,33 @@ +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 diff --git a/gcc/fortran/arith.c b/gcc/fortran/arith.c index ff279db..10b3e5c 100644 --- a/gcc/fortran/arith.c +++ b/gcc/fortran/arith.c @@ -2510,9 +2510,9 @@ hollerith2representation (gfc_expr *result, gfc_expr *src) 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); @@ -2527,6 +2527,36 @@ hollerith2representation (gfc_expr *result, gfc_expr *src) } +/* 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 * @@ -2542,8 +2572,21 @@ gfc_hollerith2int (gfc_expr *src, int kind) 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) @@ -2558,6 +2601,21 @@ 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. */ @@ -2574,6 +2632,21 @@ gfc_hollerith2complex (gfc_expr *src, int kind) 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. */ @@ -2609,3 +2682,18 @@ gfc_hollerith2logical (gfc_expr *src, int kind) 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; +} diff --git a/gcc/fortran/arith.h b/gcc/fortran/arith.h index 39366ca..85c8b8c 100644 --- a/gcc/fortran/arith.h +++ b/gcc/fortran/arith.h @@ -77,7 +77,11 @@ gfc_expr *gfc_hollerith2real (gfc_expr *, int); 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 */ diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index c508890..9e3c8c4 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -3722,6 +3722,12 @@ gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue, int conform, || 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; diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi index 02d30e1..a34ac5a 100644 --- a/gcc/fortran/gfortran.texi +++ b/gcc/fortran/gfortran.texi @@ -1600,6 +1600,7 @@ additional compatibility extensions along with those enabled by * Unary operators:: * Implicitly convert LOGICAL and INTEGER values:: * Hollerith constants support:: +* Character conversion:: * Cray pointers:: * CONVERT specifier:: * OpenMP:: @@ -1955,6 +1956,30 @@ obtained by using the @code{TRANSFER} statement, as in this example. @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 diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c index ac5af10..572967f 100644 --- a/gcc/fortran/intrinsic.c +++ b/gcc/fortran/intrinsic.c @@ -4025,6 +4025,29 @@ add_conversions (void) 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); + } } @@ -5119,8 +5142,10 @@ gfc_convert_type_warn (gfc_expr *expr, gfc_typespec *ts, int eflag, int wflag) /* 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) @@ -5135,14 +5160,14 @@ gfc_convert_type_warn (gfc_expr *expr, gfc_typespec *ts, int eflag, int 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) @@ -5159,7 +5184,7 @@ gfc_convert_type_warn (gfc_expr *expr, gfc_typespec *ts, int eflag, int wflag) "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); @@ -5171,7 +5196,7 @@ gfc_convert_type_warn (gfc_expr *expr, gfc_typespec *ts, int eflag, int wflag) { /* 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), @@ -5180,13 +5205,21 @@ gfc_convert_type_warn (gfc_expr *expr, gfc_typespec *ts, int eflag, int wflag) 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. */ @@ -5244,8 +5277,7 @@ bad: } gfc_internal_error ("Cannot convert %qs to %qs at %L", type_name, - gfc_typename (ts), - &expr->where); + gfc_typename (ts), &expr->where); /* Not reached */ } diff --git a/gcc/fortran/invoke.texi b/gcc/fortran/invoke.texi index 1d5cec1..46ee3c9 100644 --- a/gcc/fortran/invoke.texi +++ b/gcc/fortran/invoke.texi @@ -118,9 +118,9 @@ by type. Explanations are in the following sections. @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 @@ -273,14 +273,19 @@ For details on GNU Fortran's implementation of these extensions see the 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}, diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt index 35b1206..5fcd1ff 100644 --- a/gcc/fortran/lang.opt +++ b/gcc/fortran/lang.opt @@ -460,6 +460,11 @@ fdec-blank-format-item 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. diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c index c875ec1..305c57d 100644 --- a/gcc/fortran/options.c +++ b/gcc/fortran/options.c @@ -76,6 +76,7 @@ set_dec_flags (int value) 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. */ diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 218c2ed..a39b954 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -10689,6 +10689,18 @@ resolve_ordinary_assign (gfc_code *code, gfc_namespace *ns) 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) { diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c index fa5aefe..2eb1943 100644 --- a/gcc/fortran/simplify.c +++ b/gcc/fortran/simplify.c @@ -8522,10 +8522,31 @@ gfc_convert_constant (gfc_expr *e, bt type, int kind) 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: diff --git a/gcc/fortran/trans-const.c b/gcc/fortran/trans-const.c index 432d12b..7ce0263 100644 --- a/gcc/fortran/trans-const.c +++ b/gcc/fortran/trans-const.c @@ -25,6 +25,7 @@ along with GCC; see the file COPYING3. If not see #include "coretypes.h" #include "tree.h" #include "gfortran.h" +#include "options.h" #include "trans.h" #include "fold-const.h" #include "stor-layout.h" @@ -331,8 +332,9 @@ gfc_conv_constant_to_tree (gfc_expr * expr) 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 |