FreeChainXenon/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

re PR fortran/57834 (C_F_POINTER (only with -std=): accepts only explicit- and assumed-size arrays for FPTR when SHAPE is present)

Browse source 
2013-07-08  Tobias Burnus  <burnus@net-b.de>

        PR fortran/57834
        * check.c (is_c_interoperable): Add special case for
        * c_f_pointer.
        (explicit-size, gfc_check_c_f_pointer, gfc_check_c_loc): Update
        call.

2013-07-08  Tobias Burnus  <burnus@net-b.de>

        PR fortran/57834
        * gfortran.dg/c_f_pointer_tests_8.f90: New.

From-SVN: r200794
This commit is contained in:
Tobias Burnus 2013-07-08 21:05:16 +02:00 • committed by Tobias Burnus
parent 4a283fdfbf
commit 5e7ea2143a
4 changed files with 57 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
gcc/fortran/ChangeLog
View file

@ -1,3 +1,10 @@
2013-07-08 Tobias Burnus <burnus@net-b.de>
PR fortran/57834
* check.c (is_c_interoperable): Add special case for c_f_pointer.
(explicit-size, gfc_check_c_f_pointer, gfc_check_c_loc): Update
call.
2013-07-08 Tobias Burnus <burnus@net-b.de>
PR fortran/50554

14
gcc/fortran/check.c
View file

@ -3650,10 +3650,11 @@ gfc_check_sizeof (gfc_expr *arg)
otherwise, it is set to NULL. The msg string can be used in diagnostics.
If c_loc is true, character with len > 1 are allowed (cf. Fortran
2003corr5); additionally, assumed-shape/assumed-rank/deferred-shape
arrays are permitted. */
arrays are permitted. And if c_f_ptr is true, deferred-shape arrays
are permitted. */
static bool
is_c_interoperable (gfc_expr *expr, const char **msg, bool c_loc)
is_c_interoperable (gfc_expr *expr, const char **msg, bool c_loc, bool c_f_ptr)
{
*msg = NULL;
@ -3734,7 +3735,8 @@ is_c_interoperable (gfc_expr *expr, const char **msg, bool c_loc)
*msg = "Only whole-arrays are interoperable";
return false;
}
if (ar->as->type != AS_EXPLICIT && ar->as->type != AS_ASSUMED_SIZE)
if (!c_f_ptr && ar->as->type != AS_EXPLICIT
&& ar->as->type != AS_ASSUMED_SIZE)
{
*msg = "Only explicit-size and assumed-size arrays are interoperable";
return false;
@ -3750,7 +3752,7 @@ gfc_check_c_sizeof (gfc_expr *arg)
{
const char *msg;
if (!is_c_interoperable (arg, &msg, false))
if (!is_c_interoperable (arg, &msg, false, false))
{
gfc_error ("'%s' argument of '%s' intrinsic at %L must be an "
"interoperable data entity: %s",
@ -3900,7 +3902,7 @@ gfc_check_c_f_pointer (gfc_expr *cptr, gfc_expr *fptr, gfc_expr *shape)
return false;
}
if (!is_c_interoperable (fptr, &msg, false) && fptr->rank)
if (!is_c_interoperable (fptr, &msg, false, true))
return gfc_notify_std (GFC_STD_F2008_TS, "Noninteroperable array FPTR "
"at %L to C_F_POINTER: %s", &fptr->where, msg);
@ -4029,7 +4031,7 @@ gfc_check_c_loc (gfc_expr *x)
return false;
}
if (!is_c_interoperable (x, &msg, true))
if (!is_c_interoperable (x, &msg, true, false))
{
if (x->ts.type == BT_CLASS)
{

5
gcc/testsuite/ChangeLog
View file

@ -1,3 +1,8 @@
2013-07-08 Tobias Burnus <burnus@net-b.de>
PR fortran/57834
* gfortran.dg/c_f_pointer_tests_8.f90: New.
2013-07-08 Tobias Burnus <burnus@net-b.de>
PR fortran/50554

37
gcc/testsuite/gfortran.dg/c_f_pointer_tests_8.f90 Normal file
View file

@ -0,0 +1,37 @@
! { dg-do compile }
! { dg-options "-std=f2003" }
!
! PR fortran/57834
!
! (Gave a bogus warning before.)
!
program main
use iso_c_binding
use iso_fortran_env
implicit none
interface
function strerror(errno) bind(C, NAME = 'strerror')
import
type(C_PTR) :: strerror
integer(C_INT), value :: errno
end function
end interface
integer :: i
type(C_PTR) :: cptr
character(KIND=C_CHAR), pointer :: str(:)
cptr = strerror(INT(42, KIND = C_INT))
call C_F_POINTER(cptr, str, [255])
do i = 1, SIZE(str)
if (str(i) == C_NULL_CHAR) exit
write (ERROR_UNIT, '(A1)', ADVANCE = 'NO') str(i:i)
enddo
write (ERROR_UNIT, '(1X)')
end program main