Fortran: Fix "str" to scalar descriptor conversion [PR92482]

	PR fortran/92482
gcc/fortran/ChangeLog:

	* trans-expr.c (gfc_conv_procedure_call): Use TREE_OPERAND not
	build_fold_indirect_ref_loc to undo an ADDR_EXPR.

gcc/testsuite/ChangeLog:

	* gfortran.dg/bind-c-char-descr.f90: Remove xfail; extend a bit.

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 013893730651b94a3d65c027ccd5601533a3ab1a..29697e69e75b7a28cc779861fdb55e177dadfd0d 100644 (file)
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -6640,7 +6640,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
                    {
                      tmp = parmse.expr;
                      if (TREE_CODE (tmp) == ADDR_EXPR)
-                       tmp = build_fold_indirect_ref_loc (input_location, tmp);
+                       tmp = TREE_OPERAND (tmp, 0);
                      parmse.expr = gfc_conv_scalar_to_descriptor (&parmse, tmp,
                                                                   fsym->attr);
                      parmse.expr = gfc_build_addr_expr (NULL_TREE,

diff --git a/gcc/testsuite/gfortran.dg/bind-c-char-descr.f90 b/gcc/testsuite/gfortran.dg/bind-c-char-descr.f90
index 3b01ad3b63d76be877bf1049e32cc0a0436daa3f..8829fd1f71bfd83a50b6b10606ac798450b58d48 100644 (file)
--- a/gcc/testsuite/gfortran.dg/bind-c-char-descr.f90
+++ b/gcc/testsuite/gfortran.dg/bind-c-char-descr.f90
@@ -2,7 +2,6 @@
 !
 ! Contributed by José Rui Faustino de Sousa 
 !
-! Note the xfail issue below for 'strg_print_2("abc")
 
 program strp_p
 
@@ -24,13 +23,18 @@ program strp_p
   if (len(str) /= 3 .or. str /= "abc") stop 1
   if (len(strp_1) /= 3 .or. strp_1 /= "abc") stop 2
   if (len(strp_2) /= 3 .or. strp_2 /= "abc") stop 3
-  call strg_print_0("abc") ! Error (10.0.0) or segmentation fault (9.1.0)
-  call strg_print_0(str) ! Error (10.0.0) or segmentation fault (9.1.0)
-  call strg_print_0(strp_1) ! Error (10.0.0) or segmentation fault (9.1.0)
-  call strg_print_0(strp_2) ! Error (10.0.0) or segmentation fault (9.1.0)
-  call strg_print_1(strp_1) ! Not yet supported
+  call strg_print_0("abc")
+  call strg_print_0(str)
+  call strg_print_0(strp_1)
+  call strg_print_0(strp_2)
+  call strg_print_0_c("abc")
+  call strg_print_0_c(str)
+  call strg_print_0_c(strp_1)
+  call strg_print_0_c(strp_2)
+  call strg_print_1(strp_1)
+  call strg_print_1_c(strp_1)
 
-  call strg_print_2("abc", xfail=.true.)
+  call strg_print_2("abc")
   call strg_print_2(str)
   call strg_print_2(strp_1)
   call strg_print_2(strp_2)
@@ -42,14 +46,21 @@ program strp_p
 
 contains
 
-  subroutine strg_print_0(this) bind(c) ! Error (10.0.0 20191106) or warning (9.1.0) issued with bind(c)
+  subroutine strg_print_0 (this)
     character(len=*, kind=c_char), target, intent(in) :: this
 
     if (len (this) /= 3) stop 10
     if (this /= "abc") stop 11
   end subroutine strg_print_0
+
+  subroutine strg_print_0_c (this) bind(c)
+    character(len=*, kind=c_char), target, intent(in) :: this
+
+    if (len (this) /= 3) stop 10
+    if (this /= "abc") stop 11
+  end subroutine strg_print_0_c
   
-  subroutine strg_print_1(this) bind(c) ! Not yet supported with bind(c)
+  subroutine strg_print_1 (this) bind(c)
     character(len=:, kind=c_char), pointer, intent(in) :: this
     character(len=:), pointer :: strn
 
@@ -63,26 +74,34 @@ contains
        if (this /= "abc") stop 25
      end if
    end subroutine strg_print_1
+
+  subroutine strg_print_1_c (this) bind(c)
+    character(len=:, kind=c_char), pointer, intent(in) :: this
+    character(len=:), pointer :: strn
+
+    if (.not. associated (this)) stop 20
+    if (len (this) /= 3) stop 21
+    if (this /= "abc") stop 22
+     strn => this
+     if (.not. associated (strn)) stop 23
+     if(associated(strn))then
+       if (len (this) /= 3) stop 24
+       if (this /= "abc") stop 25
+     end if
+   end subroutine strg_print_1_c
   
-  subroutine strg_print_2(this, xfail)
+  subroutine strg_print_2(this)
     use, intrinsic :: iso_c_binding, only: &
       c_loc, c_f_pointer
     
     type(*), target, intent(in) :: this(..)
-    logical, optional, value :: xfail
     character(len=l), pointer :: strn
 
     call c_f_pointer(c_loc(this), strn)
     if (.not. associated (strn)) stop 30
-    if(associated(strn))then
+    if (associated(strn)) then
       if (len (strn) /= 3) stop 31
-      if (strn /= "abc") then
-        if (present (xfail)) then
-          print *, 'INVALID STRING - EXPECTED "abc" / PR47225'
-        else
-          stop 32
-        end if
-      end if
+      if (strn /= "abc") stop 32
     end if
   end subroutine strg_print_2