OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR fortran/44925 ([OOP] C_LOC with CLASS pointer)

Browse Source 
2010-07-14  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/44925
	* gfortran.h (gfc_is_data_pointer): Remove prototype.
	* dependency.c (gfc_is_data_pointer): Make it static.
	* intrinsic.texi: Update documentation on C_LOC.
	* resolve.c (gfc_iso_c_func_interface): Fix pointer and target checks
	and add a check for polymorphic variables.


2010-07-14  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/44925
	* gfortran.dg/c_loc_tests_15.f90: New.

From-SVN: r162169
This commit is contained in:
Janus Weil 2010-07-14 10:09:05 +02:00
parent fa86d337f6
commit f6199e635e
7 changed files with 46 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
gcc/fortran/ChangeLog
View File

@ -1,3 +1,12 @@
2010-07-14 Janus Weil <janus@gcc.gnu.org>
PR fortran/44925
* gfortran.h (gfc_is_data_pointer): Remove prototype.
* dependency.c (gfc_is_data_pointer): Make it static.
* intrinsic.texi: Update documentation on C_LOC.
* resolve.c (gfc_iso_c_func_interface): Fix pointer and target checks
and add a check for polymorphic variables.
2010-07-14 Jakub Jelinek <jakub@redhat.com>
* trans-expr.c (string_to_single_character): Also optimize

2
gcc/fortran/dependency.c
View File

@ -424,7 +424,7 @@ gfc_ref_needs_temporary_p (gfc_ref *ref)
}
int
static int
gfc_is_data_pointer (gfc_expr *e)
{
gfc_ref *ref;

1
gcc/fortran/gfortran.h
View File

@ -2810,7 +2810,6 @@ void gfc_global_used (gfc_gsymbol *, locus *);
/* dependency.c */
int gfc_dep_compare_expr (gfc_expr *, gfc_expr *);
int gfc_is_data_pointer (gfc_expr *);
/* check.c */
gfc_try gfc_check_same_strlen (const gfc_expr*, const gfc_expr*, const char*);

6
gcc/fortran/intrinsic.texi
View File

@ -2142,9 +2142,9 @@ Inquiry function
@code{RESULT = C_LOC(X)}
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
@item @var{X} @tab Associated scalar pointer or interoperable scalar
or allocated allocatable variable with @code{TARGET} attribute.
@multitable @columnfractions .10 .75
@item @var{X} @tab Shall have either the POINTER or TARGET attribute. It shall not be a coindexed object. It shall either be a variable with interoperable type and kind type parameters, or be a scalar, nonpolymorphic variable with no length type parameters.
@end multitable
@item @emph{Return value}:

17
gcc/fortran/resolve.c
View File

@ -2440,10 +2440,11 @@ gfc_iso_c_func_interface (gfc_symbol *sym, gfc_actual_arglist *args,
{
char name[GFC_MAX_SYMBOL_LEN + 1];
char binding_label[GFC_MAX_BINDING_LABEL_LEN + 1];
int optional_arg = 0, is_pointer = 0;
int optional_arg = 0;
gfc_try retval = SUCCESS;
gfc_symbol *args_sym;
gfc_typespec *arg_ts;
symbol_attribute arg_attr;
if (args->expr->expr_type == EXPR_CONSTANT
|| args->expr->expr_type == EXPR_OP
@ -2460,8 +2461,7 @@ gfc_iso_c_func_interface (gfc_symbol *sym, gfc_actual_arglist *args,
and not necessarily that of the expr symbol (args_sym), because
the actual expression could be a part-ref of the expr symbol. */
arg_ts = &(args->expr->ts);
is_pointer = gfc_is_data_pointer (args->expr);
arg_attr = gfc_expr_attr (args->expr);
if (sym->intmod_sym_id == ISOCBINDING_ASSOCIATED)
{
@ -2504,7 +2504,7 @@ gfc_iso_c_func_interface (gfc_symbol *sym, gfc_actual_arglist *args,
else if (sym->intmod_sym_id == ISOCBINDING_LOC)
{
/* Make sure we have either the target or pointer attribute. */
if (!args_sym->attr.target && !is_pointer)
if (!arg_attr.target && !arg_attr.pointer)
{
gfc_error_now ("Parameter '%s' to '%s' at %L must be either "
"a TARGET or an associated pointer",
@ -2587,7 +2587,7 @@ gfc_iso_c_func_interface (gfc_symbol *sym, gfc_actual_arglist *args,
}
}
}
else if (is_pointer
else if (arg_attr.pointer
&& is_scalar_expr_ptr (args->expr) != SUCCESS)
{
/* Case 1c, section 15.1.2.5, J3/04-007: an associated
@ -2622,6 +2622,13 @@ gfc_iso_c_func_interface (gfc_symbol *sym, gfc_actual_arglist *args,
&(args->expr->where));
retval = FAILURE;
}
else if (arg_ts->type == BT_CLASS)
{
gfc_error_now ("Parameter '%s' to '%s' at %L must not be "
"polymorphic", args_sym->name, sym->name,
&(args->expr->where));
retval = FAILURE;
}
}
}
else if (sym->intmod_sym_id == ISOCBINDING_FUNLOC)

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2010-07-14 Janus Weil <janus@gcc.gnu.org>
PR fortran/44925
* gfortran.dg/c_loc_tests_15.f90: New.
2010-07-13 Jason Merrill <jason@redhat.com>
PR c++/44909

16
gcc/testsuite/gfortran.dg/c_loc_tests_15.f90 Normal file
View File

@ -0,0 +1,16 @@
! { dg-do compile }
!
! PR 44925: [OOP] C_LOC with CLASS pointer
!
! Contributed by Barron Bichon <barron.bichon@swri.org>
use iso_c_binding
type :: t
end type t
type(c_ptr) :: tt_cptr
class(t), pointer :: tt_fptr
if (associated(tt_fptr)) tt_cptr = c_loc(tt_fptr) ! { dg-error "must not be polymorphic" }
end