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
This commit is contained in:
parent
b3f27c1577
commit
665733c121
@ -1,3 +1,8 @@
|
||||
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>
|
||||
|
||||
PR rtl-optimization/323
|
||||
|
@ -1632,8 +1632,11 @@ gfc_sym_type (gfc_symbol * sym)
|
||||
if (sym->backend_decl && !sym->attr.function)
|
||||
return TREE_TYPE (sym->backend_decl);
|
||||
|
||||
if (sym->ts.type == BT_CHARACTER && sym->attr.is_bind_c
|
||||
&& (sym->attr.function || sym->attr.result))
|
||||
if (sym->ts.type == BT_CHARACTER
|
||||
&& ((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;
|
||||
else
|
||||
type = gfc_typenode_for_spec (&sym->ts);
|
||||
@ -1962,7 +1965,11 @@ gfc_return_by_reference (gfc_symbol * sym)
|
||||
if (sym->attr.dimension)
|
||||
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;
|
||||
|
||||
/* Possibly return complex numbers by reference for g77 compatibility.
|
||||
|
@ -1,3 +1,7 @@
|
||||
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>
|
||||
|
||||
PR rtl-optimization/323
|
||||
|
31
gcc/testsuite/gfortran.dg/bind_c_usage_19.f90
Normal file
31
gcc/testsuite/gfortran.dg/bind_c_usage_19.f90
Normal file
@ -0,0 +1,31 @@
|
||||
! { 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
|
Loading…
x
Reference in New Issue
Block a user