Skip to content

R
riscv-gcc-1
Commit 1b04be5d by Janus Weil
Options

re PR fortran/54667 ([OOP] gimplification failure with c_f_pointer) 

2012-09-30  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/54667
	* intrinsic.texi (C_F_POINTER): Fix description.
	* resolve.c (gfc_iso_c_sub_interface): Add a check for FPTR argument
	of C_F_POINTER. Modify two error messages. Cleanup.

2012-09-30  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/54667
	* gfortran.dg/c_funloc_tests_6.f90: Modified error message.
	* gfortran.dg/c_f_pointer_shape_test.f90: Ditto.
	* gfortran.dg/c_f_pointer_tests_5.f90: New.

From-SVN: r191870
parent b4ca0e1a
Showing with 62 additions and 26 deletions
gcc/fortran/ChangeLog
2012-09-30 Janus Weil <janus@gcc.gnu.org>
PR fortran/54667
* intrinsic.texi (C_F_POINTER): Fix description.
* resolve.c (gfc_iso_c_sub_interface): Add a check for FPTR argument
of C_F_POINTER. Modify two error messages. Cleanup.
2012-09-24 Tobias Burnus <burnus@net-b.de>
PR fortran/54618
......
gcc/fortran/intrinsic.texi
......@@ -2362,9 +2362,8 @@ end program main
@table @asis
@item @emph{Description}:
@code{C_F_POINTER(CPTR, FPTR[, SHAPE])} Assign the target the C pointer
@var{CPTR} to the Fortran pointer @var{FPTR} and specify its
shape.
@code{C_F_POINTER(CPTR, FPTR[, SHAPE])} assigns the target of the C pointer
@var{CPTR} to the Fortran pointer @var{FPTR} and specifies its shape.
@item @emph{Standard}:
Fortran 2003 and later
......
gcc/fortran/resolve.c
......@@ -3532,36 +3532,45 @@ gfc_iso_c_sub_interface (gfc_code *c, gfc_symbol *sym)
{
if (c->ext.actual != NULL && c->ext.actual->next != NULL)
{
if (c->ext.actual->expr->ts.type != BT_DERIVED
|| c->ext.actual->expr->ts.u.derived->intmod_sym_id
!= ISOCBINDING_PTR)
gfc_actual_arglist *arg1 = c->ext.actual;
gfc_actual_arglist *arg2 = c->ext.actual->next;
gfc_actual_arglist *arg3 = c->ext.actual->next->next;
/* Check first argument (CPTR). */
if (arg1->expr->ts.type != BT_DERIVED
|| arg1->expr->ts.u.derived->intmod_sym_id != ISOCBINDING_PTR)
{
gfc_error ("Argument CPTR to C_F_POINTER at %L shall have "
"the type C_PTR", &arg1->expr->where);
m = MATCH_ERROR;
}
/* Check second argument (FPTR). */
if (arg2->expr->ts.type == BT_CLASS)
{
gfc_error ("Argument at %L to C_F_POINTER shall have the type"
" C_PTR", &c->ext.actual->expr->where);
gfc_error ("Argument FPTR to C_F_POINTER at %L must not be "
"polymorphic", &arg2->expr->where);
m = MATCH_ERROR;
}
/* Make sure we got a third arg if the second arg has non-zero
rank. We must also check that the type and rank are
/* Make sure we got a third arg (SHAPE) if the second arg has
non-zero rank. We must also check that the type and rank are
correct since we short-circuit this check in
gfc_procedure_use() (called above to sort actual args). */
if (c->ext.actual->next->expr->rank != 0)
if (arg2->expr->rank != 0)
{
if(c->ext.actual->next->next == NULL
|| c->ext.actual->next->next->expr == NULL)
if (arg3 == NULL || arg3->expr == NULL)
{
m = MATCH_ERROR;
gfc_error ("Missing SHAPE parameter for call to %s "
"at %L", sym->name, &(c->loc));
gfc_error ("Missing SHAPE argument for call to %s at %L",
sym->name, &c->loc);
}
else if (c->ext.actual->next->next->expr->ts.type
!= BT_INTEGER
|| c->ext.actual->next->next->expr->rank != 1)
else if (arg3->expr->ts.type != BT_INTEGER
|| arg3->expr->rank != 1)
{
m = MATCH_ERROR;
gfc_error ("SHAPE parameter for call to %s at %L must "
"be a rank 1 INTEGER array", sym->name,
&(c->loc));
gfc_error ("SHAPE argument for call to %s at %L must be "
"a rank 1 INTEGER array", sym->name, &c->loc);
}
}
}
......
gcc/testsuite/ChangeLog
2012-09-30 Janus Weil <janus@gcc.gnu.org>
PR fortran/54667
* gfortran.dg/c_funloc_tests_6.f90: Modified error message.
* gfortran.dg/c_f_pointer_shape_test.f90: Ditto.
* gfortran.dg/c_f_pointer_tests_5.f90: New.
2012-09-30 Janus Weil <janus@gcc.gnu.org>
* gfortran.dg/allocate_derived_1.f90: Re-enable class array checks,
......
gcc/testsuite/gfortran.dg/c_f_pointer_shape_test.f90
! { dg-do compile }
! verify that the compiler catches the error in the call to c_f_pointer
! because it is missing the required SHAPE parameter. the SHAPE parameter
! is optional, in general, but must exist if given a fortran pointer
! Verify that the compiler catches the error in the call to c_f_pointer
! because it is missing the required SHAPE argument. The SHAPE argument
! is optional, in general, but must exist if given a Fortran pointer
! to a non-zero rank object. --Rickett, 09.26.06
module c_f_pointer_shape_test
contains
......@@ -13,7 +13,8 @@ contains
type(c_ptr), value :: cPtr
myArrayPtr => myArray
call c_f_pointer(cPtr, myArrayPtr) ! { dg-error "Missing SHAPE parameter" }
call c_f_pointer(cPtr, myArrayPtr) ! { dg-error "Missing SHAPE argument" }
end subroutine test_0
end module c_f_pointer_shape_test
! { dg-final { cleanup-modules "c_f_pointer_shape_test" } }
gcc/testsuite/gfortran.dg/c_f_pointer_tests_5.f90 0 → 100644
! { dg-do compile }
!
! PR 54667: [OOP] gimplification failure with c_f_pointer
!
! Contributed by Andrew Benson <abensonca@gmail.com>
use, intrinsic :: ISO_C_Binding
type :: nc
end type
type(c_ptr) :: cSelf
class(nc), pointer :: self
call c_f_pointer(cSelf, self) ! { dg-error "must not be polymorphic" }
end
gcc/testsuite/gfortran.dg/c_funloc_tests_6.f90
......@@ -23,7 +23,7 @@ procedure(integer), pointer :: fint
cp = c_funloc (sub) ! { dg-error "Can't convert TYPE.c_funptr. to TYPE.c_ptr." })
cfp = c_loc (int) ! { dg-error "Can't convert TYPE.c_ptr. to TYPE.c_funptr." }
call c_f_pointer (cfp, int) ! { dg-error "Argument at .1. to C_F_POINTER shall have the type C_PTR" }
call c_f_pointer (cfp, int) ! { dg-error "Argument CPTR to C_F_POINTER at .1. shall have the type C_PTR" }
call c_f_procpointer (cp, fsub) ! { dg-error "Argument at .1. to C_F_FUNPOINTER shall have the type C_FUNPTR" }
cfp = c_funloc (noCsub) ! { dg-error "TS 29113: Noninteroperable argument 'nocsub' to 'c_funloc'" }
......
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