Hi Thomas,
Updated patch – now having submitted the mapping patch,
I can focus on other things, including this patch.
I have now removed the setting of the typespec – and
added an assert to be sure everything is consistent.
At least for the testsuite, it is.
Thanks for insisting on doing it properly. It was clear
that the previous code was wrong – but it was not obvious
whether updating the kind value was ever useful.
However, testing indicates that the expression-type
resolution works and the answer is "never".
Thus, an alternative patch would be to just remove
the e-> ... = ... without adding an assert.
OK – with assert or without?
Tobias
On 6/24/20 10:02 PM, Thomas Koenig wrote:
Hi Tobias,
could you review the second patch instead? I have sent the wrong
patch (early draft) and corrected it half an hour later!
Sorry, I missed that. Here's the review of the real patch :-)
So, the first part is
+ if (ts)
+ e->ts.kind = ts->kind;
Ok, I unerstand that - ts has been set earlier for a component.
But this part
+ else if (e->ts.type != BT_CHARACTER)
+ e->ts.kind = gfc_default_character_kind;
I do not quite understand. How can the type of an expression involving
a substring not be BT_CHARACTER when gfc_resolve_substring_charlen is
called? Or is it BT_UNKNOWN, and a check for that might be better?
And, if it is indeed BT_UNKNOWN, how do we know it isn't a
CHARACTER(KIND=4)?
Best Regards
Thomas
-----------------
Mentor Graphics (Deutschland) GmbH, Arnulfstraße 201, 80634 München / Germany
Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Alexander
Walter
Fortran: Fix character-kind=4 substring resolution (PR95837)
gcc/fortran/ChangeLog:
PR fortran/95837
* resolve.c (gfc_resolve_substring_charlen): Remove
bogus ts.kind setting for the expression; add assert.
gcc/testsuite/ChangeLog:
PR fortran/95837
* gfortran.dg/char4-subscript.f90: New test.
gcc/fortran/resolve.c | 7 +++++--
gcc/testsuite/gfortran.dg/char4-subscript.f90 | 30 +++++++++++++++++++++++++++
2 files changed, 35 insertions(+), 2 deletions(-)
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index c53b312f7ed..1d0655dd440 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -5140,8 +5140,11 @@ gfc_resolve_substring_charlen (gfc_expr *e)
return;
}
- e->ts.type = BT_CHARACTER;
- e->ts.kind = gfc_default_character_kind;
+ gcc_assert (e->ts.type == BT_CHARACTER && (e->ts.kind == 1 || e->ts.kind == 4)
+ && (!ts || e->ts.kind == ts->kind)
+ && (ts
+ || e->expr_type != EXPR_VARIABLE
+ || e->ts.kind == e->symtree->n.sym->ts.kind));
if (!e->ts.u.cl)
e->ts.u.cl = gfc_new_charlen (gfc_current_ns, NULL);
diff --git a/gcc/testsuite/gfortran.dg/char4-subscript.f90 b/gcc/testsuite/gfortran.dg/char4-subscript.f90
new file mode 100644
index 00000000000..f1f915c7af9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char4-subscript.f90
@@ -0,0 +1,30 @@
+! { dg-do run }
+! { dg-additional-options "-fdump-tree-original" }
+!
+! PR fortran/95837
+!
+type t
+ character(len=:, kind=4), pointer :: str2
+end type t
+type(t) :: var
+
+allocate(character(len=5, kind=4) :: var%str2)
+
+var%str2(1:1) = 4_"d"
+var%str2(2:3) = 4_"ef"
+var%str2(4:4) = achar(int(Z'1F600'), kind=4)
+var%str2(5:5) = achar(int(Z'1F608'), kind=4)
+
+if (var%str2(1:3) /= 4_"def") stop 1
+if (ichar(var%str2(4:4)) /= int(Z'1F600')) stop 2
+if (ichar(var%str2(5:5)) /= int(Z'1F608')) stop 2
+
+deallocate(var%str2)
+end
+
+! Note: the last '\x00' is regarded as string terminator, hence, the tailing \0 byte is not in the dump
+
+! { dg-final { scan-tree-dump " \\(\\*var\\.str2\\)\\\[1\\\]{lb: 1 sz: 4} = .d\\\\x00\\\\x00.\\\[1\\\]{lb: 1 sz: 4};" "original" } }
+! { dg-final { scan-tree-dump " __builtin_memmove \\(\\(void \\*\\) &\\(\\*var.str2\\)\\\[2\\\]{lb: 1 sz: 4}, \\(void \\*\\) &.e\\\\x00\\\\x00\\\\x00f\\\\x00\\\\x00.\\\[1\\\]{lb: 1 sz: 4}, 8\\);" "original" } }
+! { dg-final { scan-tree-dump " \\(\\*var.str2\\)\\\[4\\\]{lb: 1 sz: 4} = .\\\\x00\\\\xf6\\\\x01.\\\[1\\\]{lb: 1 sz: 4};" "original" } }
+! { dg-final { scan-tree-dump " \\(\\*var.str2\\)\\\[5\\\]{lb: 1 sz: 4} = .\\\\b\\\\xf6\\\\x01.\\\[1\\\]{lb: 1 sz: 4};" "original" } }
