diff options
| author | Harald Anlauf <anlauf@gmx.de> | 2023-06-28 22:16:18 +0200 |
|---|---|---|
| committer | Harald Anlauf <anlauf@gmx.de> | 2023-06-28 22:16:18 +0200 |
| commit | 8736d6b14a4dfdfb58c80ccd398981b0fb5d00aa (patch) | |
| tree | b4bee1b3d6822572b7219d41e2ad377b99fdbc91 /gcc | |
| parent | 4cf64d9cc2faf4001f037a50a350abd0f95f3e29 (diff) | |
| download | gcc-8736d6b14a4dfdfb58c80ccd398981b0fb5d00aa.zip gcc-8736d6b14a4dfdfb58c80ccd398981b0fb5d00aa.tar.gz gcc-8736d6b14a4dfdfb58c80ccd398981b0fb5d00aa.tar.bz2 | |
Fortran: ABI for scalar CHARACTER(LEN=1),VALUE dummy argument [PR110360]
gcc/fortran/ChangeLog:
PR fortran/110360
* trans-expr.cc (gfc_conv_procedure_call): For non-constant string
argument passed to CHARACTER(LEN=1),VALUE dummy, ensure proper
dereferencing and truncation of string to length 1.
gcc/testsuite/ChangeLog:
PR fortran/110360
* gfortran.dg/value_9.f90: Add tests for intermediate regression.
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/fortran/trans-expr.cc | 15 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/value_9.f90 | 23 |
2 files changed, 33 insertions, 5 deletions
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index ad0cdf9..30946ba 100644 --- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -6395,7 +6395,7 @@ 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. - Constant strings are truncated to length 1. + Strings are truncated to length 1. The BIND(C) case is handled elsewhere. */ if (fsym->ts.type == BT_CHARACTER && !fsym->ts.is_c_interop @@ -6405,10 +6405,15 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, (fsym->ts.u.cl->length->value.integer, 1) == 0)) { if (e->expr_type != EXPR_CONSTANT) - parmse.expr = gfc_string_to_single_character - (build_int_cst (gfc_charlen_type_node, 1), - parmse.expr, - e->ts.kind); + { + tree slen1 = build_int_cst (gfc_charlen_type_node, 1); + gfc_conv_string_parameter (&parmse); + 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) { e->value.character.length = 1; diff --git a/gcc/testsuite/gfortran.dg/value_9.f90 b/gcc/testsuite/gfortran.dg/value_9.f90 index f649064..1a2fa80 100644 --- a/gcc/testsuite/gfortran.dg/value_9.f90 +++ b/gcc/testsuite/gfortran.dg/value_9.f90 @@ -9,7 +9,12 @@ program p character (kind=4), allocatable :: ca4 character (kind=4), pointer :: cp4 character(len=:,kind=4), allocatable :: cd4 + character :: c = "1" + character (kind=4) :: c4 = 4_"4" + character(len=3) :: d = "210" + character(len=3,kind=4) :: d4 = 4_"321" integer :: a = 65 + integer :: l = 2 allocate (ca, cp, ca4, cp4) ! Check len=1 actual argument cases first @@ -20,15 +25,21 @@ program p 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") @@ -37,6 +48,18 @@ program p 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)) cd = "gkl"; cd4 = 4_"hmn" call val (cd,cd) call val4 (cd4,cd4) |