From patchwork Mon Oct 21 14:40:27 2019 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Mark Eggleston X-Patchwork-Id: 1180673 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=209.132.180.131; helo=sourceware.org; envelope-from=gcc-patches-return-511432-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=fail (p=none dis=none) header.from=codethink.co.uk Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="D0nI9lWD"; dkim-atps=neutral Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 46xfSy0lxbz9sNw for ; Tue, 22 Oct 2019 01:40:48 +1100 (AEDT) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :subject:to:message-id:date:mime-version:content-type; q=dns; s= default; b=l+kAMpqulqCcath6nUuRaBDasK4eSoLIKcynmrYE/wXuUe8b2jMnj Y7aQc1sCpBEM7ONzf10f39NZMHKvxy/2txZaHC2+HODlftJfll6LwUiuo/PuYOJz oN/Zzockewj6y5byESVLRGBP3XJ5VKutx+nxjAcbpwggn03BF051LM= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :subject:to:message-id:date:mime-version:content-type; s= default; bh=NlaP++Oyc9v9DanFHQcKgaj5TjU=; b=D0nI9lWDbtXMqlbfhVuv ptsrxoUgLUMBCijS3OxofR606PI6S4eGJzs38DBU49MA1PnVFU7Co1JNFcBNcTTm K+rzqCRY9tZdtqKjbkXdSxem9BeYOp0s3d1EAHLE9tZxcTaKZZsJPfXXEnCrozlW u8dGHJFArKhGLuFmmXDVFMY= Received: (qmail 83748 invoked by alias); 21 Oct 2019 14:40:38 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 83692 invoked by uid 89); 21 Oct 2019 14:40:37 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-19.7 required=5.0 tests=AWL, BAYES_00, GIT_PATCH_0, GIT_PATCH_1, GIT_PATCH_2, GIT_PATCH_3, KAM_COUK, RCVD_IN_DNSWL_NONE, SPF_HELO_PASS, SPF_PASS autolearn=ham version=3.3.1 spammy=H*F:D*uk, H*F:D*co.uk, ABCD, www.codethink.co.uk X-HELO: imap1.codethink.co.uk Received: from imap1.codethink.co.uk (HELO imap1.codethink.co.uk) (176.9.8.82) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Mon, 21 Oct 2019 14:40:31 +0000 Received: from [167.98.27.226] (helo=[10.35.5.11]) by imap1.codethink.co.uk with esmtpsa (Exim 4.84_2 #1 (Debian)) id 1iMYrE-0007go-CB; Mon, 21 Oct 2019 15:40:28 +0100 From: Mark Eggleston Subject: [PATCH, Fortran] Allow CHARACTER literals in assignments and DATA statements - for review To: gcc-patches , fortran Message-ID: <6ef3c9e9-0c3c-d860-4589-cb0be4f3333a@codethink.co.uk> Date: Mon, 21 Oct 2019 15:40:27 +0100 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:60.0) Gecko/20100101 Thunderbird/60.9.0 MIME-Version: 1.0 This is an extension to support a legacy feature supported by other compilers such as flang and the sun compiler.  As I understand it this feature is associated with DEC so it enabled using -fdec-char-conversions and by -fdec. It allows character literals to be assigned to numeric (INTEGER, REAL, COMPLEX) and LOGICAL variables by direct assignment or in DATA statements. Please find attached the patch which includes changes to the gfortran manual. Tested on x86_64 using "make check-fortran". Change logs: gcc/fortran/ChangeLog     Jim MacArthur      Mark Eggleston      * 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.     * gfortran.texi: Add -fdec-char-conversions.     * intrinsic.c (add_convdersions): Add conversions from character to     integer, real, complex and logical types for their supported kinds.     * 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. gcc/testsuite/ChangeLog     Jim MacArthur     Mark Eggleston     PR fortran/89103     * 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_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/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. From 26a2a7f4a65331f519ced628dfe7e0fa7b3ce513 Mon Sep 17 00:00:00 2001 From: Jim MacArthur Date: Thu, 4 Feb 2016 17:18:30 +0000 Subject: [PATCH] Allow CHARACTER literals in assignments and data statements Warnings are raised when this happens. Enable using -fdec-char-as-int or -fdec --- gcc/fortran/arith.c | 94 +++++++++++++++++++++- gcc/fortran/arith.h | 4 + gcc/fortran/expr.c | 5 ++ gcc/fortran/gfortran.texi | 24 ++++++ gcc/fortran/intrinsic.c | 32 +++++++- gcc/fortran/invoke.texi | 17 ++-- gcc/fortran/lang.opt | 5 ++ gcc/fortran/options.c | 1 + gcc/fortran/resolve.c | 9 +++ gcc/fortran/simplify.c | 29 ++++++- gcc/fortran/trans-const.c | 6 +- .../dec_char_conversion_in_assignment_1.f90 | 61 ++++++++++++++ .../dec_char_conversion_in_assignment_2.f90 | 61 ++++++++++++++ .../dec_char_conversion_in_assignment_3.f90 | 61 ++++++++++++++ .../gfortran.dg/dec_char_conversion_in_data_1.f90 | 69 ++++++++++++++++ .../gfortran.dg/dec_char_conversion_in_data_2.f90 | 69 ++++++++++++++++ .../gfortran.dg/dec_char_conversion_in_data_3.f90 | 69 ++++++++++++++++ .../gfortran.dg/dec_char_conversion_in_data_4.f90 | 9 +++ gcc/testsuite/gfortran.dg/hollerith5.f90 | 5 +- gcc/testsuite/gfortran.dg/hollerith_legacy.f90 | 2 +- .../gfortran.dg/no_char_to_numeric_assign.f90 | 21 +++++ 21 files changed, 634 insertions(+), 19 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/dec_char_conversion_in_assignment_1.f90 create mode 100644 gcc/testsuite/gfortran.dg/dec_char_conversion_in_assignment_2.f90 create mode 100644 gcc/testsuite/gfortran.dg/dec_char_conversion_in_assignment_3.f90 create mode 100644 gcc/testsuite/gfortran.dg/dec_char_conversion_in_data_1.f90 create mode 100644 gcc/testsuite/gfortran.dg/dec_char_conversion_in_data_2.f90 create mode 100644 gcc/testsuite/gfortran.dg/dec_char_conversion_in_data_3.f90 create mode 100644 gcc/testsuite/gfortran.dg/dec_char_conversion_in_data_4.f90 create mode 100644 gcc/testsuite/gfortran.dg/no_char_to_numeric_assign.f90 diff --git a/gcc/fortran/arith.c b/gcc/fortran/arith.c index ff279db4992..ad071c71c3f 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 " + "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,6 +2572,19 @@ 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. */ @@ -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 39366caaba1..85c8b8cef41 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 c508890d68d..f04d19f7409 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -3722,6 +3722,11 @@ 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) + 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 02d30e19660..8341bcda199 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,29 @@ 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. + +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 ac5af10a775..9cfbac363bf 100644 --- a/gcc/fortran/intrinsic.c +++ b/gcc/fortran/intrinsic.c @@ -4025,6 +4025,28 @@ add_conversions (void) add_conv (BT_LOGICAL, gfc_logical_kinds[j].kind, BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_LEGACY); } + + /* Flang allows character conversions similar to Hollerith conversions + - the first characters will be turned into ascii values. */ + 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); + } } @@ -5185,8 +5207,16 @@ gfc_convert_type_warn (gfc_expr *expr, gfc_typespec *ts, int eflag, int wflag) gfc_typename (&from_ts), gfc_dummy_typename (ts), &expr->where); } + else if (flag_dec_char_conversions && from_ts.type == BT_CHARACTER + && (gfc_numeric_ts (ts) || ts->type == BT_LOGICAL)) + { + const char *type_name = is_char_constant ? gfc_typename (expr) + : gfc_typename (&from_ts); + gfc_warning_now (OPT_Wconversion, "Conversion from %s to %s at %L", + type_name, gfc_typename (ts), &expr->where); + } else - gcc_unreachable (); + gcc_unreachable (); } /* Insert a pre-resolved function call to the right function. */ diff --git a/gcc/fortran/invoke.texi b/gcc/fortran/invoke.texi index fa60effdbfe..4d01ddeaa07 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 @@ -272,14 +272,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 2cfc76df2ab..a6e73e1292d 100644 --- a/gcc/fortran/lang.opt +++ b/gcc/fortran/lang.opt @@ -456,6 +456,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 771c10e4985..6d5bc0655f8 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 93f2d0aa761..c824a6b7ac1 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -10689,6 +10689,15 @@ 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) + { + 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 fa5aefe20c6..2eb1943c3ee 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 432d12bf168..e4df0a7b1a5 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 (OPT_Wsurprising, "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 diff --git a/gcc/testsuite/gfortran.dg/dec_char_conversion_in_assignment_1.f90 b/gcc/testsuite/gfortran.dg/dec_char_conversion_in_assignment_1.f90 new file mode 100644 index 00000000000..d504f92fbbc --- /dev/null +++ b/gcc/testsuite/gfortran.dg/dec_char_conversion_in_assignment_1.f90 @@ -0,0 +1,61 @@ +! { dg-do run } +! { dg-options "-fdec -Wsurprising -Wcharacter-truncation" } +! +! Modified by Mark Eggleston +! +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' ! { dg-warning "undefined result" } + e = 4h1234 + f = 4h1234 + g = 8h12341234 + h = 4h1234 ! { dg-warning "undefined result" } + + 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' ! { dg-warning "undefined result" } + e = 2h12 + f = 2h12 + g = 5h12234 + h = 3h123 ! { dg-warning "undefined result" } + + 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' ! { dg-warning "truncated in" } + b = '123478' ! { dg-warning "truncated in" } + c = '12341234987' ! { dg-warning "truncated in" } + d = '1234abc' ! { dg-warning "truncated in|undefined result" } + e = 6h123478 ! { dg-warning "truncated in" } + f = 6h123478 ! { dg-warning "truncated in" } + g = 11h12341234987 ! { dg-warning "truncated in" } + h = 7h1234abc ! { dg-warning "truncated in|undefined result" } + + 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 + diff --git a/gcc/testsuite/gfortran.dg/dec_char_conversion_in_assignment_2.f90 b/gcc/testsuite/gfortran.dg/dec_char_conversion_in_assignment_2.f90 new file mode 100644 index 00000000000..737ddc664de --- /dev/null +++ b/gcc/testsuite/gfortran.dg/dec_char_conversion_in_assignment_2.f90 @@ -0,0 +1,61 @@ +! { dg-do run } +! { dg-options "-fdec-char-conversions -std=legacy -Wcharacter-truncation -Wsurprising" } +! +! Modified by Mark Eggleston +! +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' ! { dg-warning "undefined result" } + e = 4h1234 + f = 4h1234 + g = 8h12341234 + h = 4h1234 ! { dg-warning "undefined result" } + + 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' ! { dg-warning "undefined result" } + e = 2h12 + f = 2h12 + g = 5h12234 + h = 3h123 ! { dg-warning "undefined result" } + + 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' ! { dg-warning "truncated in" } + b = '123478' ! { dg-warning "truncated in" } + c = '12341234987' ! { dg-warning "truncated in" } + d = '1234abc' ! { dg-warning "truncated in|undefined result" } + e = 6h123478 ! { dg-warning "truncated in" } + f = 6h123478 ! { dg-warning "truncated in" } + g = 11h12341234987 ! { dg-warning "truncated in" } + h = 7h1234abc ! { dg-warning "truncated in|undefined result" } + + 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 + diff --git a/gcc/testsuite/gfortran.dg/dec_char_conversion_in_assignment_3.f90 b/gcc/testsuite/gfortran.dg/dec_char_conversion_in_assignment_3.f90 new file mode 100644 index 00000000000..0ec494c4a92 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/dec_char_conversion_in_assignment_3.f90 @@ -0,0 +1,61 @@ +! { dg-do run } +! { dg-options "-fdec -fno-dec-char-conversions" } +! +! Modified by Mark Eggleston +! +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' ! { dg-error "Cannot convert" } + b = '1234' ! { dg-error "Cannot convert" } + c = '12341234' ! { dg-error "Cannot convert" } + d = '1234' ! { dg-error "Cannot convert" } + 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' ! { dg-error "Cannot convert" } + b = '12' ! { dg-error "Cannot convert" } + c = '12234' ! { dg-error "Cannot convert" } + d = '124' ! { dg-error "Cannot convert" } + 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' ! { dg-error "Cannot convert" } + b = '123478' ! { dg-error "Cannot convert" } + c = '12341234987' ! { dg-error "Cannot convert" } + d = '1234abc' ! { dg-error "Cannot convert" } + 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 + diff --git a/gcc/testsuite/gfortran.dg/dec_char_conversion_in_data_1.f90 b/gcc/testsuite/gfortran.dg/dec_char_conversion_in_data_1.f90 new file mode 100644 index 00000000000..c493be9314b --- /dev/null +++ b/gcc/testsuite/gfortran.dg/dec_char_conversion_in_data_1.f90 @@ -0,0 +1,69 @@ +! { dg-do run } +! { dg-options "-fdec -Wsurprising" } +! +! Modified by Mark Eggleston +! + +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, b, c, d / '1234', '1234', '12341234', '1234' / ! { dg-warning "undefined result" } + data e, f, g, h / 4h1234, 4h1234, 8h12341234, 4h1234 / ! { dg-warning "undefined result" } + + 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, b, c, d / '12', '12', '12334', '123' / ! { dg-warning "undefined result" } + data e, f, g, h / 2h12, 2h12, 5h12334, 3h123 / ! { dg-warning "undefined result" } + + 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, b, c, d / '123478', '123478', '1234123498', '12345' / ! { dg-warning "too long|undefined result" } + data e, f, g, h / 6h123478, 6h123478, 10h1234123498, 5h12345 / ! { dg-warning "too long|undefined result" } + + 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 + diff --git a/gcc/testsuite/gfortran.dg/dec_char_conversion_in_data_2.f90 b/gcc/testsuite/gfortran.dg/dec_char_conversion_in_data_2.f90 new file mode 100644 index 00000000000..c7d8e241cec --- /dev/null +++ b/gcc/testsuite/gfortran.dg/dec_char_conversion_in_data_2.f90 @@ -0,0 +1,69 @@ +! { dg-do run } +! { dg-options "-fdec-char-conversions -std=legacy -Wsurprising" } +! +! Modified by Mark Eggleston +! + +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, b, c, d / '1234', '1234', '12341234', '1234' / ! { dg-warning "undefined result" } + data e, f, g, h / 4h1234, 4h1234, 8h12341234, 4h1234 / ! { dg-warning "undefined result" } + + 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, b, c, d / '12', '12', '12334', '123' / ! { dg-warning "undefined result" } + data e, f, g, h / 2h12, 2h12, 5h12334, 3h123 / ! { dg-warning "undefined result" } + + 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, b, c, d / '123478', '123478', '1234123498', '12345' / ! { dg-warning "too long|undefined result" } + data e, f, g, h / 6h123478, 6h123478, 10h1234123498, 5h12345 / ! { dg-warning "too long|undefined result" } + + 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 + diff --git a/gcc/testsuite/gfortran.dg/dec_char_conversion_in_data_3.f90 b/gcc/testsuite/gfortran.dg/dec_char_conversion_in_data_3.f90 new file mode 100644 index 00000000000..e7d084b5ffc --- /dev/null +++ b/gcc/testsuite/gfortran.dg/dec_char_conversion_in_data_3.f90 @@ -0,0 +1,69 @@ +! { dg-do run } +! { dg-options "-fdec -fno-dec-char-conversions" } +! +! Modified by Mark Eggleston +! + +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, b, c, d / '1234', '1234', '12341234', '1234' / ! { dg-error "Incompatible types" } + data e, f, g, h / 4h1234, 4h1234, 8h12341234, 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, b, c, d / '12', '12', '12334', '123' / ! { dg-error "Incompatible types" } + data e, f, g, h / 2h12, 2h12, 5h12334, 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, b, c, d / '123478', '123478', '1234123498', '12345' / ! { dg-error "Incompatible types" } + data e, f, g, h / 6h123478, 6h123478, 10h1234123498, 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 + diff --git a/gcc/testsuite/gfortran.dg/dec_char_conversion_in_data_4.f90 b/gcc/testsuite/gfortran.dg/dec_char_conversion_in_data_4.f90 new file mode 100644 index 00000000000..6eff27e14bc --- /dev/null +++ b/gcc/testsuite/gfortran.dg/dec_char_conversion_in_data_4.f90 @@ -0,0 +1,9 @@ +! { dg-do compile } +! { dg-options "-fdec -Wconversion" } +! +! Ensure that character type name is correctly reported. + +program test + integer(4) x + data x / 'ABCD' / ! { dg-warning "CHARACTER\\(4\\) to INTEGER\\(4\\)" } +end program diff --git a/gcc/testsuite/gfortran.dg/hollerith5.f90 b/gcc/testsuite/gfortran.dg/hollerith5.f90 index ebd0a117c4f..d17f9ae40cf 100644 --- a/gcc/testsuite/gfortran.dg/hollerith5.f90 +++ b/gcc/testsuite/gfortran.dg/hollerith5.f90 @@ -1,8 +1,9 @@ ! { 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 } diff --git a/gcc/testsuite/gfortran.dg/hollerith_legacy.f90 b/gcc/testsuite/gfortran.dg/hollerith_legacy.f90 index c3322498345..9d7e989b552 100644 --- a/gcc/testsuite/gfortran.dg/hollerith_legacy.f90 +++ b/gcc/testsuite/gfortran.dg/hollerith_legacy.f90 @@ -1,5 +1,5 @@ ! { dg-do compile } -! { dg-options "-std=legacy" } +! { dg-options "-std=legacy -Wsurprising" } ! PR15966, PR18781 & PR16531 implicit none complex(kind=8) x(2) diff --git a/gcc/testsuite/gfortran.dg/no_char_to_numeric_assign.f90 b/gcc/testsuite/gfortran.dg/no_char_to_numeric_assign.f90 new file mode 100644 index 00000000000..3c60403160a --- /dev/null +++ b/gcc/testsuite/gfortran.dg/no_char_to_numeric_assign.f90 @@ -0,0 +1,21 @@ +! { 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 +! +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 -- 2.11.0