* [PATCH] fortran: Fix up gfc_typename CHARACTER length handling [PR97768]
@ 2020-11-10 9:58 Jakub Jelinek
2020-11-10 17:12 ` Tobias Burnus
0 siblings, 1 reply; 2+ messages in thread
From: Jakub Jelinek @ 2020-11-10 9:58 UTC (permalink / raw)
To: fortran; +Cc: gcc-patches, Mark Eggleston
Hi!
The first testcase below ICEs when f951 is 32-bit (or 64-bit big-endian).
The problem is that ex->ts.u.cl && ex->ts.u.cl->length are both non-NULL,
but ex->ts.u.cl->length->expr_type is not EXPR_CONSTANT, but EXPR_FUNCTION.
value.function.actual and value.function.name are in that case pointers,
but value._mp_alloc and value._mp_size are 4 byte integers no matter what.
So, in 64-bit little-endian the function returns most of the time incorrect
CHARACTER(0) because the most significant 32 bits of the
value.function.actual pointer are likely 0.
Anyway, the following patch is an attempt to get all the cases right.
Uses ex->value.character.length only for ex->expr_type == EXPR_CONSTANT
(i.e. CHARACTER literals), handles the deferred lengths, assumed lengths,
known constant lengths and finally if the length is something other,
just doesn't print it, i.e. prints just CHARACTER (for default kind)
or CHARACTER(KIND=4) (for e.g. kind 4).
The earlier version of the patch has been successfully bootstrapped
and regtested (only with a few regressions) on x86_64-linux and i686-linux,
this version passed all the new and earlier problematic tests, ok for trunk
if it passes another bootstrap/regtest?
2020-11-10 Jakub Jelinek <jakub@redhat.com>
PR fortran/97768
* misc.c (gfc_typename): Use ex->value.character.length only if
ex->expr_type == EXPR_CONSTANT. If ex->ts.deferred, print : instead
of length. If ex->ts.u.cl && ex->ts.u.cl->length == NULL, print
* instead of length. Otherwise if character length is non-constant,
print just CHARACTER or CHARACTER(KIND=N).
* gfortran.dg/pr97768_1.f90: New test.
* gfortran.dg/pr97768_2.f90: New test.
--- gcc/fortran/misc.c.jj 2020-11-09 23:01:02.978826528 +0100
+++ gcc/fortran/misc.c 2020-11-10 10:41:22.087850720 +0100
@@ -224,10 +224,32 @@ gfc_typename (gfc_expr *ex)
if (ex->ts.type == BT_CHARACTER)
{
- if (ex->ts.u.cl && ex->ts.u.cl->length)
- length = gfc_mpz_get_hwi (ex->ts.u.cl->length->value.integer);
- else
+ if (ex->expr_type == EXPR_CONSTANT)
length = ex->value.character.length;
+ else if (ex->ts.deferred)
+ {
+ if (ex->ts.kind == gfc_default_character_kind)
+ return "CHARACTER(:)";
+ sprintf (buffer, "CHARACTER(:,%d)", ex->ts.kind);
+ return buffer;
+ }
+ else if (ex->ts.u.cl && ex->ts.u.cl->length == NULL)
+ {
+ if (ex->ts.kind == gfc_default_character_kind)
+ return "CHARACTER(*)";
+ sprintf (buffer, "CHARACTER(*,%d)", ex->ts.kind);
+ return buffer;
+ }
+ else if (ex->ts.u.cl == NULL
+ || ex->ts.u.cl->length->expr_type != EXPR_CONSTANT)
+ {
+ if (ex->ts.kind == gfc_default_character_kind)
+ return "CHARACTER";
+ sprintf (buffer, "CHARACTER(KIND=%d)", ex->ts.kind);
+ return buffer;
+ }
+ else
+ length = gfc_mpz_get_hwi (ex->ts.u.cl->length->value.integer);
if (ex->ts.kind == gfc_default_character_kind)
sprintf (buffer, "CHARACTER(" HOST_WIDE_INT_PRINT_DEC ")", length);
else
--- gcc/testsuite/gfortran.dg/pr97768_1.f90.jj 2020-11-10 10:22:26.053445061 +0100
+++ gcc/testsuite/gfortran.dg/pr97768_1.f90 2020-11-10 10:22:26.053445061 +0100
@@ -0,0 +1,25 @@
+! PR fortran/97768
+! { dg-do compile }
+
+module pr97768_1
+ interface operator(.in.)
+ module procedure substr_in_str
+ end interface
+contains
+ pure function to_upper (in_str) result (string)
+ character(len=*), intent(in) :: in_str
+ character(len=len(in_str)) :: string
+ string = in_str
+ end function to_upper
+ logical pure function substr_in_str (substring, string)
+ character(len=*), intent(in) :: string, substring
+ substr_in_str=.false.
+ end function
+end module
+function foo ()
+ use pr97768_1, only : to_upper, operator(.in.)
+ logical :: foo
+ character(len=8) :: str
+ str = 'abcde'
+ foo = 'b' .in. to_upper (str)
+end function foo
--- gcc/testsuite/gfortran.dg/pr97768_2.f90.jj 2020-11-10 10:22:26.053445061 +0100
+++ gcc/testsuite/gfortran.dg/pr97768_2.f90 2020-11-10 10:46:15.104602757 +0100
@@ -0,0 +1,53 @@
+! PR fortran/97768
+! { dg-do compile }
+
+module pr97768_2
+ interface operator(.in.)
+ module procedure substr_in_str
+ end interface
+contains
+ pure function to_upper (in_str) result (string)
+ character(len=*), intent(in) :: in_str
+ character(len=len(in_str)) :: string
+ string = in_str
+ end function to_upper
+ logical pure function substr_in_str (substring, string)
+ character(len=*), intent(in) :: string, substring
+ substr_in_str=.false.
+ end function
+end module
+function foo ()
+ use pr97768_2, only : to_upper, operator(.in.)
+ logical :: foo
+ character(len=8) :: str
+ str = 'abcde'
+ foo = to_upper (str) .in. 32 ! { dg-error "are CHARACTER/INTEGER" }
+end function foo
+function bar (str)
+ use pr97768_2, only : operator(.in.)
+ logical :: bar
+ character(len=*) :: str
+ foo = str .in. 32 ! { dg-error "are CHARACTER\\(\\*\\)/INTEGER" }
+end function bar
+function baz (lenstr)
+ use pr97768_2, only : operator(.in.)
+ logical :: baz
+ integer :: lenstr
+ character(len=lenstr) :: str
+ str = 'abc'
+ foo = str .in. 32 ! { dg-error "are CHARACTER/INTEGER" }
+end function baz
+function qux ()
+ use pr97768_2, only : operator(.in.)
+ logical :: qux
+ character(len=8) :: str
+ str = 'def'
+ foo = str .in. 32 ! { dg-error "are CHARACTER\\(8\\)/INTEGER" }
+end function qux
+function corge ()
+ use pr97768_2, only : operator(.in.)
+ logical :: corge
+ character(len=:), allocatable :: str
+ str = 'ghijk'
+ foo = str .in. 32 ! { dg-error "are CHARACTER\\(:\\)/INTEGER" }
+end function corge
Jakub
^ permalink raw reply [flat|nested] 2+ messages in thread
* Re: [PATCH] fortran: Fix up gfc_typename CHARACTER length handling [PR97768]
2020-11-10 9:58 [PATCH] fortran: Fix up gfc_typename CHARACTER length handling [PR97768] Jakub Jelinek
@ 2020-11-10 17:12 ` Tobias Burnus
0 siblings, 0 replies; 2+ messages in thread
From: Tobias Burnus @ 2020-11-10 17:12 UTC (permalink / raw)
To: Jakub Jelinek, fortran; +Cc: Mark Eggleston, gcc-patches
On 10.11.20 10:58, Jakub Jelinek via Gcc-patches wrote:
> The earlier version of the patch has been successfully bootstrapped
> and regtested (only with a few regressions) on x86_64-linux and i686-linux,
> this version passed all the new and earlier problematic tests, ok for trunk
> if it passes another bootstrap/regtest?
LGTM. Thanks!
Tobias
> 2020-11-10 Jakub Jelinek <jakub@redhat.com>
>
> PR fortran/97768
> * misc.c (gfc_typename): Use ex->value.character.length only if
> ex->expr_type == EXPR_CONSTANT. If ex->ts.deferred, print : instead
> of length. If ex->ts.u.cl && ex->ts.u.cl->length == NULL, print
> * instead of length. Otherwise if character length is non-constant,
> print just CHARACTER or CHARACTER(KIND=N).
>
> * gfortran.dg/pr97768_1.f90: New test.
> * gfortran.dg/pr97768_2.f90: New test.
>
> --- gcc/fortran/misc.c.jj 2020-11-09 23:01:02.978826528 +0100
> +++ gcc/fortran/misc.c 2020-11-10 10:41:22.087850720 +0100
> @@ -224,10 +224,32 @@ gfc_typename (gfc_expr *ex)
>
> if (ex->ts.type == BT_CHARACTER)
> {
> - if (ex->ts.u.cl && ex->ts.u.cl->length)
> - length = gfc_mpz_get_hwi (ex->ts.u.cl->length->value.integer);
> - else
> + if (ex->expr_type == EXPR_CONSTANT)
> length = ex->value.character.length;
> + else if (ex->ts.deferred)
> + {
> + if (ex->ts.kind == gfc_default_character_kind)
> + return "CHARACTER(:)";
> + sprintf (buffer, "CHARACTER(:,%d)", ex->ts.kind);
> + return buffer;
> + }
> + else if (ex->ts.u.cl && ex->ts.u.cl->length == NULL)
> + {
> + if (ex->ts.kind == gfc_default_character_kind)
> + return "CHARACTER(*)";
> + sprintf (buffer, "CHARACTER(*,%d)", ex->ts.kind);
> + return buffer;
> + }
> + else if (ex->ts.u.cl == NULL
> + || ex->ts.u.cl->length->expr_type != EXPR_CONSTANT)
> + {
> + if (ex->ts.kind == gfc_default_character_kind)
> + return "CHARACTER";
> + sprintf (buffer, "CHARACTER(KIND=%d)", ex->ts.kind);
> + return buffer;
> + }
> + else
> + length = gfc_mpz_get_hwi (ex->ts.u.cl->length->value.integer);
> if (ex->ts.kind == gfc_default_character_kind)
> sprintf (buffer, "CHARACTER(" HOST_WIDE_INT_PRINT_DEC ")", length);
> else
> --- gcc/testsuite/gfortran.dg/pr97768_1.f90.jj 2020-11-10 10:22:26.053445061 +0100
> +++ gcc/testsuite/gfortran.dg/pr97768_1.f90 2020-11-10 10:22:26.053445061 +0100
> @@ -0,0 +1,25 @@
> +! PR fortran/97768
> +! { dg-do compile }
> +
> +module pr97768_1
> + interface operator(.in.)
> + module procedure substr_in_str
> + end interface
> +contains
> + pure function to_upper (in_str) result (string)
> + character(len=*), intent(in) :: in_str
> + character(len=len(in_str)) :: string
> + string = in_str
> + end function to_upper
> + logical pure function substr_in_str (substring, string)
> + character(len=*), intent(in) :: string, substring
> + substr_in_str=.false.
> + end function
> +end module
> +function foo ()
> + use pr97768_1, only : to_upper, operator(.in.)
> + logical :: foo
> + character(len=8) :: str
> + str = 'abcde'
> + foo = 'b' .in. to_upper (str)
> +end function foo
> --- gcc/testsuite/gfortran.dg/pr97768_2.f90.jj 2020-11-10 10:22:26.053445061 +0100
> +++ gcc/testsuite/gfortran.dg/pr97768_2.f90 2020-11-10 10:46:15.104602757 +0100
> @@ -0,0 +1,53 @@
> +! PR fortran/97768
> +! { dg-do compile }
> +
> +module pr97768_2
> + interface operator(.in.)
> + module procedure substr_in_str
> + end interface
> +contains
> + pure function to_upper (in_str) result (string)
> + character(len=*), intent(in) :: in_str
> + character(len=len(in_str)) :: string
> + string = in_str
> + end function to_upper
> + logical pure function substr_in_str (substring, string)
> + character(len=*), intent(in) :: string, substring
> + substr_in_str=.false.
> + end function
> +end module
> +function foo ()
> + use pr97768_2, only : to_upper, operator(.in.)
> + logical :: foo
> + character(len=8) :: str
> + str = 'abcde'
> + foo = to_upper (str) .in. 32 ! { dg-error "are CHARACTER/INTEGER" }
> +end function foo
> +function bar (str)
> + use pr97768_2, only : operator(.in.)
> + logical :: bar
> + character(len=*) :: str
> + foo = str .in. 32 ! { dg-error "are CHARACTER\\(\\*\\)/INTEGER" }
> +end function bar
> +function baz (lenstr)
> + use pr97768_2, only : operator(.in.)
> + logical :: baz
> + integer :: lenstr
> + character(len=lenstr) :: str
> + str = 'abc'
> + foo = str .in. 32 ! { dg-error "are CHARACTER/INTEGER" }
> +end function baz
> +function qux ()
> + use pr97768_2, only : operator(.in.)
> + logical :: qux
> + character(len=8) :: str
> + str = 'def'
> + foo = str .in. 32 ! { dg-error "are CHARACTER\\(8\\)/INTEGER" }
> +end function qux
> +function corge ()
> + use pr97768_2, only : operator(.in.)
> + logical :: corge
> + character(len=:), allocatable :: str
> + str = 'ghijk'
> + foo = str .in. 32 ! { dg-error "are CHARACTER\\(:\\)/INTEGER" }
> +end function corge
>
> Jakub
>
-----------------
Mentor Graphics (Deutschland) GmbH, Arnulfstraße 201, 80634 München / Germany
Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Alexander Walter
^ permalink raw reply [flat|nested] 2+ messages in thread
end of thread, other threads:[~2020-11-10 17:13 UTC | newest]
Thread overview: 2+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2020-11-10 9:58 [PATCH] fortran: Fix up gfc_typename CHARACTER length handling [PR97768] Jakub Jelinek
2020-11-10 17:12 ` Tobias Burnus
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).