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

re PR fortran/38536 (ICE with C_LOC in resolve.c due to not properly going through expr->ref)

Browse Source 
2009-01-04  Mikael Morin  <mikael.morin@tele2.fr>

	PR fortran/38536
	* gfortran.h (gfc_is_data_pointer): Added prototype
	* resolve.c (gfc_iso_c_func_interface):
	Use gfc_is_data_pointer to test for pointer attribute.
	* dependency.c (gfc_is_data_pointer):
	Support pointer-returning functions.

2009-01-04  Mikael Morin  <mikael.morin@tele2.fr>

	PR fortran/38536
	* gfortran.dg/c_loc_tests_13.f90: New test.
	* gfortran.dg/c_loc_tests_14.f90: New test.

From-SVN: r143050
This commit is contained in:
Mikael Morin 2009-01-04 14:01:12 +01:00 committed by Mikael Morin
parent 1a8c13b33c
commit 23f2d0170d
7 changed files with 72 additions and 38 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 @@
2009-01-04 Mikael Morin <mikael.morin@tele2.fr>
PR fortran/38536
* gfortran.h (gfc_is_data_pointer): Added prototype
* resolve.c (gfc_iso_c_func_interface):
Use gfc_is_data_pointer to test for pointer attribute.
* dependency.c (gfc_is_data_pointer):
Support pointer-returning functions.
2009-01-03 Daniel Franke <franke.daniel@gmail.com>
* symbol.c (save_symbol): Don't SAVE function results.

8
gcc/fortran/dependency.c
View File

@ -422,16 +422,20 @@ gfc_ref_needs_temporary_p (gfc_ref *ref)
}
static int
int
gfc_is_data_pointer (gfc_expr *e)
{
gfc_ref *ref;
if (e->expr_type != EXPR_VARIABLE)
if (e->expr_type != EXPR_VARIABLE && e->expr_type != EXPR_FUNCTION)
return 0;
/* No subreference if it is a function */
gcc_assert (e->expr_type == EXPR_VARIABLE || !e->ref);
if (e->symtree->n.sym->attr.pointer)
return 1;
for (ref = e->ref; ref; ref = ref->next)
if (ref->type == REF_COMPONENT && ref->u.c.component->attr.pointer)
return 1;

1
gcc/fortran/gfortran.h
View File

@ -2579,6 +2579,7 @@ 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*);

41
gcc/fortran/resolve.c
View File

@ -2047,12 +2047,10 @@ 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;
int optional_arg = 0, is_pointer = 0;
gfc_try retval = SUCCESS;
gfc_symbol *args_sym;
gfc_typespec *arg_ts;
gfc_ref *parent_ref;
gfc_ref *curr_ref;
if (args->expr->expr_type == EXPR_CONSTANT
|| args->expr->expr_type == EXPR_OP
@ -2070,32 +2068,8 @@ gfc_iso_c_func_interface (gfc_symbol *sym, gfc_actual_arglist *args,
the actual expression could be a part-ref of the expr symbol. */
arg_ts = &(args->expr->ts);
/* Get the parent reference (if any) for the expression. This happens for
cases such as a%b%c. */
parent_ref = args->expr->ref;
curr_ref = NULL;
if (parent_ref != NULL)
{
curr_ref = parent_ref->next;
while (curr_ref != NULL && curr_ref->next != NULL)
{
parent_ref = curr_ref;
curr_ref = curr_ref->next;
}
}
/* If curr_ref is non-NULL, we had a part-ref expression. If the curr_ref
is for a REF_COMPONENT, then we need to use it as the parent_ref for
the name, etc. Otherwise, the current parent_ref should be correct. */
if (curr_ref != NULL && curr_ref->type == REF_COMPONENT)
parent_ref = curr_ref;
if (parent_ref == args->expr->ref)
parent_ref = NULL;
else if (parent_ref != NULL && parent_ref->type != REF_COMPONENT)
gfc_internal_error ("Unexpected expression reference type in "
"gfc_iso_c_func_interface");
is_pointer = gfc_is_data_pointer (args->expr);
if (sym->intmod_sym_id == ISOCBINDING_ASSOCIATED)
{
/* If the user gave two args then they are providing something for
@ -2137,10 +2111,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)
&& !(args_sym->attr.pointer)
&& (parent_ref == NULL ||
!parent_ref->u.c.component->attr.pointer))
if (!args_sym->attr.target && !is_pointer)
{
gfc_error_now ("Parameter '%s' to '%s' at %L must be either "
"a TARGET or an associated pointer",
@ -2223,9 +2194,7 @@ gfc_iso_c_func_interface (gfc_symbol *sym, gfc_actual_arglist *args,
}
}
}
else if ((args_sym->attr.pointer == 1 ||
(parent_ref != NULL
&& parent_ref->u.c.component->attr.pointer))
else if (is_pointer
&& is_scalar_expr_ptr (args->expr) != SUCCESS)
{
/* Case 1c, section 15.1.2.5, J3/04-007: an associated

6
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,9 @@
2009-01-04 Mikael Morin <mikael.morin@tele2.fr>
PR fortran/38536
* gfortran.dg/c_loc_tests_13.f90: New test.
* gfortran.dg/c_loc_tests_14.f90: New test.
2009-01-03 Daniel Franke <franke.daniel@gmail.com>
* gfortran.dg/func_result_4.f90: New.

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

@ -0,0 +1,16 @@
! { dg-do compile }
!
! PR fortran/38536
! Consecutive array and substring references rejected as C_LOC argument
!
! contributed by Scot Breitenfield <brtnfld@hdfgroup.org>
USE ISO_C_BINDING
TYPE test
CHARACTER(LEN=2), DIMENSION(1:2) :: c
END TYPE test
TYPE(test), TARGET :: chrScalar
TYPE(C_PTR) :: f_ptr
f_ptr = C_LOC(chrScalar%c(1)(1:1))
END

29
gcc/testsuite/gfortran.dg/c_loc_tests_14.f90 Normal file
View File

@ -0,0 +1,29 @@
! { dg-do compile }
!
! PR fortran/38536
! Accept as argument to C_LOC a subcomponent accessed through a pointer.
USE ISO_C_BINDING
IMPLICIT NONE
TYPE test3
INTEGER, DIMENSION(5) :: b
END TYPE test3
TYPE test2
TYPE(test3), DIMENSION(:), POINTER :: a
END TYPE test2
TYPE test
TYPE(test2), DIMENSION(2) :: c
END TYPE test
TYPE(test) :: chrScalar
TYPE(C_PTR) :: f_ptr
TYPE(test3), TARGET :: d(3)
chrScalar%c(1)%a => d
f_ptr = C_LOC(chrScalar%c(1)%a(1)%b(1))
end