Commit 665733c1 by Jakub Jelinek Committed by Jakub Jelinek

trans-types.c (gfc_sym_type, [...]): For sym->attr.result check sym->ns->proc_name->attr.is_bind_c.

	* trans-types.c (gfc_sym_type, gfc_return_by_reference): For
	sym->attr.result check sym->ns->proc_name->attr.is_bind_c.

	* gfortran.dg/bind_c_usage_19.f90: New test.

From-SVN: r145294
parent b3f27c15
2009-03-30 Jakub Jelinek <jakub@redhat.com>
* trans-types.c (gfc_sym_type, gfc_return_by_reference): For
sym->attr.result check sym->ns->proc_name->attr.is_bind_c.
2009-03-30 Joseph Myers <joseph@codesourcery.com> 2009-03-30 Joseph Myers <joseph@codesourcery.com>
PR rtl-optimization/323 PR rtl-optimization/323
......
...@@ -1632,8 +1632,11 @@ gfc_sym_type (gfc_symbol * sym) ...@@ -1632,8 +1632,11 @@ gfc_sym_type (gfc_symbol * sym)
if (sym->backend_decl && !sym->attr.function) if (sym->backend_decl && !sym->attr.function)
return TREE_TYPE (sym->backend_decl); return TREE_TYPE (sym->backend_decl);
if (sym->ts.type == BT_CHARACTER && sym->attr.is_bind_c if (sym->ts.type == BT_CHARACTER
&& (sym->attr.function || sym->attr.result)) && ((sym->attr.function && sym->attr.is_bind_c)
|| (sym->attr.result
&& sym->ns->proc_name
&& sym->ns->proc_name->attr.is_bind_c)))
type = gfc_character1_type_node; type = gfc_character1_type_node;
else else
type = gfc_typenode_for_spec (&sym->ts); type = gfc_typenode_for_spec (&sym->ts);
...@@ -1962,7 +1965,11 @@ gfc_return_by_reference (gfc_symbol * sym) ...@@ -1962,7 +1965,11 @@ gfc_return_by_reference (gfc_symbol * sym)
if (sym->attr.dimension) if (sym->attr.dimension)
return 1; return 1;
if (sym->ts.type == BT_CHARACTER && !sym->attr.is_bind_c) if (sym->ts.type == BT_CHARACTER
&& !sym->attr.is_bind_c
&& (!sym->attr.result
|| !sym->ns->proc_name
|| !sym->ns->proc_name->attr.is_bind_c))
return 1; return 1;
/* Possibly return complex numbers by reference for g77 compatibility. /* Possibly return complex numbers by reference for g77 compatibility.
......
2009-03-30 Jakub Jelinek <jakub@redhat.com>
* gfortran.dg/bind_c_usage_19.f90: New test.
2009-03-30 Joseph Myers <joseph@codesourcery.com> 2009-03-30 Joseph Myers <joseph@codesourcery.com>
PR rtl-optimization/323 PR rtl-optimization/323
......
! { dg-do compile }
function return_char1(i) bind(c,name='return_char1')
use iso_c_binding
implicit none
integer(c_int) :: i
character(c_char) :: j
character(c_char) :: return_char1
j = achar(i)
return_char1 = j
end function return_char1
function return_char2(i) result(output) bind(c,name='return_char2')
use iso_c_binding
implicit none
integer(c_int) :: i
character(c_char) :: j
character(c_char) :: output
j = achar(i)
output = j
end function return_char2
function return_char3(i) bind(c,name='return_char3') result(output)
use iso_c_binding
implicit none
integer(c_int) :: i
character(c_char) :: j
character(c_char) :: output
j = achar(i)
output = j
end function return_char3
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment