Re: [Patch, fortran] PR109684 - compiling failure: complaining about a final subroutine of a type being not PURE (while it is indeed PURE)
On 8/9/23 7:58 AM, Paul Richard Thomas via Fortran wrote: I took a look at my calendar and decided to backport right away. r13-7703-ged049e5d5f36cc0f4318cd93bb6b33ed6f6f2ba7 BTW It is a regression :-) Paul On Wed, 9 Aug 2023 at 12:10, Paul Richard Thomas wrote: Committed to trunk as 'obvious' in r14-3098-gb8ec3c952324f866f191883473922e250be81341 13-branch to follow in a few days. Paul Thanks Paul, I was about ready to do it myself. Jerry
[PATCH 2/3] fortran: Fix length one character dummy arg type [PR110419]
Revision r14-2171-g8736d6b14a4dfdfb58c80ccd398981b0fb5d00aa
changed the argument passing convention for length 1 value dummy
arguments to pass just the single character by value. However, the
procedure declarations weren't updated to reflect the change in the
argument types.
This change does the missing argument type update.
The change of argument types generated an internal error in
gfc_conv_string_parameter with value_9.f90. Indeed, that function is
not prepared for bare character type, so it is updated as well.
The condition guarding the single character argument passing code
is loosened to not exclude non-interoperable kind (this fixes
a regression with c_char_tests_2.f03).
Finally, the constant string argument passing code is updated as well
to extract the single char and pass it instead of passing it as
a length one string. As the code taking care of non-constant arguments
was already doing this, the condition guarding it is just removed.
With these changes, value_9.f90 passes on 32 bits big-endian powerpc.
PR fortran/110360
PR fortran/110419
gcc/fortran/ChangeLog:
* trans-types.cc (gfc_sym_type): Use a bare character type for length
one value character dummy arguments.
* trans-expr.cc (gfc_conv_string_parameter): Handle single character
case.
(gfc_conv_procedure_call): Don't exclude interoperable kinds
from single character handling. For single character dummy arguments,
extend the existing handling of non-constant expressions to constant
expressions.
gcc/testsuite/ChangeLog:
* gfortran.dg/bind_c_usage_13.f03: Update tree dump patterns.
---
gcc/fortran/trans-expr.cc | 35 +++
gcc/fortran/trans-types.cc| 5 ++-
gcc/testsuite/gfortran.dg/bind_c_usage_13.f03 | 8 ++---
3 files changed, 28 insertions(+), 20 deletions(-)
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 6da3975f77c..d91cc9da221 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -6451,26 +6451,24 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
/* ABI: actual arguments to CHARACTER(len=1),VALUE
dummy arguments are actually passed by value.
- Strings are truncated to length 1.
- The BIND(C) case is handled elsewhere. */
- if (!fsym->ts.is_c_interop
- && gfc_length_one_character_type_p (>ts))
+ Strings are truncated to length 1. */
+ if (gfc_length_one_character_type_p (>ts))
{
- if (e->expr_type != EXPR_CONSTANT)
- {
- tree slen1 = build_int_cst (gfc_charlen_type_node,
1);
- gfc_conv_string_parameter ();
- parmse.expr = gfc_string_to_single_character (slen1,
-
parmse.expr,
-
e->ts.kind);
- /* Truncate resulting string to length 1. */
- parmse.string_length = slen1;
- }
- else if (e->value.character.length > 1)
+ if (e->expr_type == EXPR_CONSTANT
+ && e->value.character.length > 1)
{
e->value.character.length = 1;
gfc_conv_expr (, e);
}
+
+ tree slen1 = build_int_cst (gfc_charlen_type_node, 1);
+ gfc_conv_string_parameter ();
+ parmse.expr
+ = gfc_string_to_single_character (slen1,
+ parmse.expr,
+ e->ts.kind);
+ /* Truncate resulting string to length 1. */
+ parmse.string_length = slen1;
}
if (fsym->attr.optional
@@ -10610,6 +10608,13 @@ gfc_conv_string_parameter (gfc_se * se)
{
tree type;
+ if (TREE_CODE (TREE_TYPE (se->expr)) == INTEGER_TYPE
+ && integer_onep (se->string_length))
+{
+ se->expr = gfc_build_addr_expr (NULL_TREE, se->expr);
+ return;
+}
+
if (TREE_CODE (se->expr) == STRING_CST)
{
type = TREE_TYPE (TREE_TYPE (se->expr));
diff --git a/gcc/fortran/trans-types.cc b/gcc/fortran/trans-types.cc
index 987e3d26c46..084b8c3ae2c 100644
--- a/gcc/fortran/trans-types.cc
+++ b/gcc/fortran/trans-types.cc
@@ -2313,7 +2313,10 @@ gfc_sym_type (gfc_symbol * sym, bool is_bind_c)
&& sym->ns->proc_name
&& sym->ns->proc_name->attr.is_bind_c)
||
[PATCH 1/3] fortran: New predicate gfc_length_one_character_type_p
Introduce a new predicate to simplify conditionals checking for
a character type whose length is the constant one.
gcc/fortran/ChangeLog:
* gfortran.h (gfc_length_one_character_type_p): New inline
function.
* check.cc (is_c_interoperable): Use
gfc_length_one_character_type_p.
* decl.cc (verify_bind_c_sym): Same.
* trans-expr.cc (gfc_conv_procedure_call): Same.
---
gcc/fortran/check.cc | 7 +++
gcc/fortran/decl.cc | 4 +---
gcc/fortran/gfortran.h| 15 +++
gcc/fortran/trans-expr.cc | 8 ++--
4 files changed, 21 insertions(+), 13 deletions(-)
diff --git a/gcc/fortran/check.cc b/gcc/fortran/check.cc
index 4086dc71d34..6c45e6542f0 100644
--- a/gcc/fortran/check.cc
+++ b/gcc/fortran/check.cc
@@ -5250,10 +5250,9 @@ is_c_interoperable (gfc_expr *expr, const char **msg,
bool c_loc, bool c_f_ptr)
&& !gfc_simplify_expr (expr->ts.u.cl->length, 0))
gfc_internal_error ("is_c_interoperable(): gfc_simplify_expr failed");
-if (!c_loc && expr->ts.u.cl
- && (!expr->ts.u.cl->length
- || expr->ts.u.cl->length->expr_type != EXPR_CONSTANT
- || mpz_cmp_si (expr->ts.u.cl->length->value.integer, 1) != 0))
+if (!c_loc
+ && expr->ts.u.cl
+ && !gfc_length_one_character_type_p (>ts))
{
*msg = "Type shall have a character length of 1";
return false;
diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc
index 844345df77e..8182ef29f43 100644
--- a/gcc/fortran/decl.cc
+++ b/gcc/fortran/decl.cc
@@ -6064,9 +6064,7 @@ verify_bind_c_sym (gfc_symbol *tmp_sym, gfc_typespec *ts,
/* BIND(C) functions cannot return a character string. */
if (bind_c_function && tmp_sym->ts.type == BT_CHARACTER)
- if (tmp_sym->ts.u.cl == NULL || tmp_sym->ts.u.cl->length == NULL
- || tmp_sym->ts.u.cl->length->expr_type != EXPR_CONSTANT
- || mpz_cmp_si (tmp_sym->ts.u.cl->length->value.integer, 1) != 0)
+ if (!gfc_length_one_character_type_p (_sym->ts))
gfc_error ("Return type of BIND(C) function %qs of character "
"type at %L must have length 1", tmp_sym->name,
&(tmp_sym->declared_at));
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 6482a885211..d44e5286626 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -3181,6 +3181,21 @@ gfc_finalizer;
/ Function prototypes */
+
+/* Returns true if the type specified in TS is a character type whose length
+ is the constant one. Otherwise returns false. */
+
+inline bool
+gfc_length_one_character_type_p (gfc_typespec *ts)
+{
+ return ts->type == BT_CHARACTER
+&& ts->u.cl
+&& ts->u.cl->length
+&& ts->u.cl->length->expr_type == EXPR_CONSTANT
+&& ts->u.cl->length->ts.type == BT_INTEGER
+&& mpz_cmp_ui (ts->u.cl->length->value.integer, 1) == 0;
+}
+
/* decl.cc */
bool gfc_in_match_data (void);
match gfc_match_char_spec (gfc_typespec *);
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index ef3e6d08f78..6da3975f77c 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -6453,12 +6453,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
dummy arguments are actually passed by value.
Strings are truncated to length 1.
The BIND(C) case is handled elsewhere. */
- if (fsym->ts.type == BT_CHARACTER
- && !fsym->ts.is_c_interop
- && fsym->ts.u.cl->length->expr_type == EXPR_CONSTANT
- && fsym->ts.u.cl->length->ts.type == BT_INTEGER
- && (mpz_cmp_ui
- (fsym->ts.u.cl->length->value.integer, 1) == 0))
+ if (!fsym->ts.is_c_interop
+ && gfc_length_one_character_type_p (>ts))
{
if (e->expr_type != EXPR_CONSTANT)
{
--
2.40.1
[PATCH 0/3] fortran: fix length one character dummy args [PR110419]
Hello, I propose with this patchset a fix for the test value_9.f90 which has been failing on 32 bits powerpc since it was added a few weeks back (see PR110360 and PR110419). The problem is an argument type mismatch between a procedure declaration, and the argument value for a call of that same procedure, in the specific case of length one character dummy arguments with the value attribute. Admittedly, our argument passing conventions [1] for those are currently unspecified. Before PR110360, character dummy arguments with value attribute were arrays passed by value, but the actual argument was still passed as reference. PR110360 changed that to pass length one dummies as bare character (i.e. scalar integer), like in the bind(c) case (but with length argument still present). However, the argument type in the function declaration wasn't changed at the same time, so the test was failing on big-endian 32 bits targets. Surprisingly, on most targets the middle-end, back-end and runtime are happy to get a scalar value passed where a length one array is expected. This can be fixed, either by reverting back to arguments represented as arrays passed by value with calls fixed, or by keeping the new representation with single characters for arguments and fixing the procedure types accordingly. I haven't really tried the first way, this is using the second one. The first patch is a preliminary refactoring. The main change is the second patch. It modifies the types of length one character dummy argsuments with value attribute in the procedure declarations, so that they are scalar integer types, consistently with how arguments are passed for calls. The third patch is a change of error codes in the testcase. I have regression tested this on x86_64-unknown-linux-gnu, and powerpc64-unknown-linux-gnu (both -m32 and -m64). OK for master? [1] https://gcc.gnu.org/onlinedocs/gfortran/Argument-passing-conventions.html Mikael Morin (3): fortran: New predicate gfc_length_one_character_type_p fortran: Fix length one character dummy arg type [PR110419] testsuite: Use distinct explicit error codes in value_9.f90 gcc/fortran/check.cc | 7 +- gcc/fortran/decl.cc | 4 +- gcc/fortran/gfortran.h| 15 +++ gcc/fortran/trans-expr.cc | 39 --- gcc/fortran/trans-types.cc| 5 +- gcc/testsuite/gfortran.dg/bind_c_usage_13.f03 | 8 +- gcc/testsuite/gfortran.dg/value_9.f90 | 108 +- 7 files changed, 103 insertions(+), 83 deletions(-) -- 2.40.1
[PATCH 3/3] testsuite: Use distinct explicit error codes in value_9.f90
Use distinct error codes, so that we can spot directly from the
testsuite log which case is failing.
gcc/testsuite/ChangeLog:
* gfortran.dg/value_9.f90 (val, val4, sub, sub4): Take the error
codes from the arguments.
(p): Update calls: pass explicit distinct error codes.
---
gcc/testsuite/gfortran.dg/value_9.f90 | 108 +-
1 file changed, 56 insertions(+), 52 deletions(-)
diff --git a/gcc/testsuite/gfortran.dg/value_9.f90
b/gcc/testsuite/gfortran.dg/value_9.f90
index 1a2fa80ed0d..4813250ebaa 100644
--- a/gcc/testsuite/gfortran.dg/value_9.f90
+++ b/gcc/testsuite/gfortran.dg/value_9.f90
@@ -20,78 +20,82 @@ program p
! Check len=1 actual argument cases first
ca = "a"; cp = "b"; cd = "c"
ca4 = 4_"d"; cp4 = 4_"e"; cd4 = 4_"f"
- call val ("B","B")
- call val ("A",char(65))
- call val ("A",char(a))
- call val ("A",mychar(65))
- call val ("A",mychar(a))
- call val ("1",c)
- call val ("1",(c))
- call val4 (4_"C",4_"C")
- call val4 (4_"A",char(65,kind=4))
- call val4 (4_"A",char(a, kind=4))
- call val4 (4_"4",c4)
- call val4 (4_"4",(c4))
- call val (ca,ca)
- call val (cp,cp)
- call val (cd,cd)
- call val (ca,(ca))
- call val4 (ca4,ca4)
- call val4 (cp4,cp4)
- call val4 (cd4,cd4)
- call val4 (cd4,(cd4))
- call sub ("S")
- call sub4 (4_"T")
+ call val ("B","B", 1, 2)
+ call val ("A",char(65), 3, 4)
+ call val ("A",char(a), 5, 6)
+ call val ("A",mychar(65), 7, 8)
+ call val ("A",mychar(a), 9, 10)
+ call val ("1",c, 11, 12)
+ call val ("1",(c), 13, 14)
+ call val4 (4_"C",4_"C", 15, 16)
+ call val4 (4_"A",char(65,kind=4), 17, 18)
+ call val4 (4_"A",char(a, kind=4), 19, 20)
+ call val4 (4_"4",c4, 21, 22)
+ call val4 (4_"4",(c4), 23, 24)
+ call val (ca,ca, 25, 26)
+ call val (cp,cp, 27, 28)
+ call val (cd,cd, 29, 30)
+ call val (ca,(ca), 31, 32)
+ call val4 (ca4,ca4, 33, 34)
+ call val4 (cp4,cp4, 35, 36)
+ call val4 (cd4,cd4, 37, 38)
+ call val4 (cd4,(cd4), 39, 40)
+ call sub ("S", 41, 42)
+ call sub4 (4_"T", 43, 44)
! Check that always the first character of the string is finally used
- call val ( "U++", "U--")
- call val4 (4_"V**",4_"V//")
- call sub ( "WTY")
- call sub4 (4_"ZXV")
- call val ( "234", d)
- call val4 (4_"345", d4 )
- call val ( "234", (d) )
- call val4 (4_"345", (d4) )
- call val ( "234", d (1:2))
- call val4 (4_"345", d4(1:2))
- call val ( "234", d (1:l))
- call val4 (4_"345", d4(1:l))
- call val ("1",c // d)
- call val ("1",trim (c // d))
- call val4 (4_"4",c4 // d4)
- call val4 (4_"4",trim (c4 // d4))
+ call val ( "U++", "U--", 45, 46)
+ call val4 (4_"V**",4_"V//", 47, 48)
+ call sub ( "WTY", 49, 50)
+ call sub4 (4_"ZXV", 51, 52)
+ call val ( "234", d, 53, 54)
+ call val4 (4_"345", d4 , 55, 56)
+ call val ( "234", (d) , 57, 58)
+ call val4 (4_"345", (d4) , 59, 60)
+ call val ( "234", d (1:2), 61, 62)
+ call val4 (4_"345", d4(1:2), 63, 64)
+ call val ( "234", d (1:l), 65, 66)
+ call val4 (4_"345", d4(1:l), 67, 68)
+ call val ("1",c // d, 69, 70)
+ call val ("1",trim (c // d), 71, 72)
+ call val4 (4_"4",c4 // d4, 73, 74)
+ call val4 (4_"4",trim (c4 // d4), 75, 76)
cd = "gkl"; cd4 = 4_"hmn"
- call val (cd,cd)
- call val4 (cd4,cd4)
- call sub (cd)
- call sub4 (cd4)
+ call val (cd,cd, 77, 78)
+ call val4 (cd4,cd4, 79, 80)
+ call sub (cd, 81, 82)
+ call sub4 (cd4, 83, 84)
deallocate (ca, cp, ca4, cp4, cd, cd4)
contains
- subroutine val (x, c)
+ subroutine val (x, c, err1, err2)
character(kind=1), intent(in) :: x ! control: pass by reference
character(kind=1), value :: c
+integer, intent(in) :: err1, err2
print *, "by value(kind=1): ", c
-if (c /= x) stop 1
+if (c /= x) stop err1
c = "*"
-if (c /= "*") stop 2
+if (c /= "*") stop err2
end
- subroutine val4 (x, c)
+ subroutine val4 (x, c, err1, err2)
character(kind=4), intent(in) :: x ! control: pass by reference
character(kind=4), value :: c
+integer, intent(in) :: err1, err2
print *, "by value(kind=4): ", c
-if (c /= x) stop 3
+if (c /= x) stop err1
c = 4_"#"
-if (c /= 4_"#") stop 4
+if (c /= 4_"#") stop err2
end
- subroutine sub (s)
+ subroutine sub (s, err1, err2)
character(*), intent(in) :: s
-call val (s, s)
+integer, intent(in) :: err1, err2
+call val (s, s, err1, err2)
end
- subroutine sub4 (s)
+ subroutine sub4 (s, err1, err2)
character(kind=4,len=*), intent(in) :: s
-call val4 (s, s)
+integer, intent(in) :: err1, err2
+call val4 (s, s, err1, err2)
end
character function mychar (i)
--
2.40.1
Re: [Patch, fortran] PR109684 - compiling failure: complaining about a final subroutine of a type being not PURE (while it is indeed PURE)
I took a look at my calendar and decided to backport right away. r13-7703-ged049e5d5f36cc0f4318cd93bb6b33ed6f6f2ba7 BTW It is a regression :-) Paul On Wed, 9 Aug 2023 at 12:10, Paul Richard Thomas wrote: > > Committed to trunk as 'obvious' in > r14-3098-gb8ec3c952324f866f191883473922e250be81341 > > 13-branch to follow in a few days. > > Paul
[Patch, fortran] PR109684 - compiling failure: complaining about a final subroutine of a type being not PURE (while it is indeed PURE)
Committed to trunk as 'obvious' in r14-3098-gb8ec3c952324f866f191883473922e250be81341 13-branch to follow in a few days. Paul
