From 650ee6fba83f72c04ec73f880703190eea76136c Mon Sep 17 00:00:00 2001 From: burnus Date: Sat, 9 Jan 2010 09:11:53 +0000 Subject: [PATCH] 2010-01-09 Tobias Burnus PR fortran/41298 * trans-expr.c (gfc_trans_structure_assign): Handle c_null_(fun)ptr. * symbol.c (gen_special_c_interop_ptr): Add NULL_EXPR to the constructor for c_null_(fun)ptr. * resolve.c (resolve_structure_cons): Add special case for c_null_(fun)ptr. 2010-01-09 Tobias Burnus PR fortran/41298 * gfortran.dg/c_ptr_tests_14.f90: New test. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@155755 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 10 ++++++ gcc/fortran/resolve.c | 11 ++++-- gcc/fortran/symbol.c | 10 +++--- gcc/fortran/trans-expr.c | 15 +++++++- gcc/testsuite/ChangeLog | 5 +++ gcc/testsuite/gfortran.dg/c_ptr_tests_14.f90 | 51 ++++++++++++++++++++++++++++ 6 files changed, 94 insertions(+), 8 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/c_ptr_tests_14.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index cb77adf..321a407 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,13 @@ +2010-01-09 Tobias Burnus + + PR fortran/41298 + * trans-expr.c (gfc_trans_structure_assign): Handle + c_null_(fun)ptr. + * symbol.c (gen_special_c_interop_ptr): Add NULL_EXPR + to the constructor for c_null_(fun)ptr. + * resolve.c (resolve_structure_cons): Add special case + for c_null_(fun)ptr. + 2010-01-09 Jakub Jelinek * gfortranspec.c (lang_specific_driver): Update copyright notice diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 0378d4f..8e8de8d 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -1,5 +1,5 @@ /* Perform type resolution on the various structures. - Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 + Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. Contributed by Andy Vaught @@ -842,13 +842,20 @@ resolve_structure_cons (gfc_expr *expr) /* See if the user is trying to invoke a structure constructor for one of the iso_c_binding derived types. */ if (expr->ts.type == BT_DERIVED && expr->ts.u.derived - && expr->ts.u.derived->ts.is_iso_c && cons && cons->expr != NULL) + && expr->ts.u.derived->ts.is_iso_c && cons + && (cons->expr == NULL || cons->expr->expr_type != EXPR_NULL)) { gfc_error ("Components of structure constructor '%s' at %L are PRIVATE", expr->ts.u.derived->name, &(expr->where)); return FAILURE; } + /* Return if structure constructor is c_null_(fun)prt. */ + if (expr->ts.type == BT_DERIVED && expr->ts.u.derived + && expr->ts.u.derived->ts.is_iso_c && cons + && cons->expr && cons->expr->expr_type == EXPR_NULL) + return SUCCESS; + for (; comp; comp = comp->next, cons = cons->next) { int rank; diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index 750aa2d..a5787de 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -1,6 +1,6 @@ /* Maintain binary trees of symbols. - Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 - Free Software Foundation, Inc. + Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, + 2009, 2010 Free Software Foundation, Inc. Contributed by Andy Vaught This file is part of GCC. @@ -3690,10 +3690,10 @@ gen_special_c_interop_ptr (int ptr_id, const char *ptr_name, tmp_sym->value->expr_type = EXPR_STRUCTURE; tmp_sym->value->ts.type = BT_DERIVED; tmp_sym->value->ts.u.derived = tmp_sym->ts.u.derived; - /* Create a constructor with no expr, that way we can recognize if the user - tries to call the structure constructor for one of the iso_c_binding - derived types during resolution (resolve_structure_cons). */ tmp_sym->value->value.constructor = gfc_get_constructor (); + tmp_sym->value->value.constructor->expr = gfc_get_expr (); + tmp_sym->value->value.constructor->expr->expr_type = EXPR_NULL; + tmp_sym->value->value.constructor->expr->ts.is_iso_c = 1; /* Must declare c_null_ptr and c_null_funptr as having the PARAMETER attribute so they can be used in init expressions. */ tmp_sym->attr.flavor = FL_PARAMETER; diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index e5fce02..5ce5dce 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -1,5 +1,5 @@ /* Expression translation - Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 + Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. Contributed by Paul Brook and Steven Bosscher @@ -4214,6 +4214,19 @@ gfc_trans_structure_assign (tree dest, gfc_expr * expr) if (!c->expr) continue; + /* Handle c_null_(fun)ptr. */ + if (c && c->expr && c->expr->ts.is_iso_c) + { + field = cm->backend_decl; + tmp = fold_build3 (COMPONENT_REF, TREE_TYPE (field), + dest, field, NULL_TREE); + tmp = fold_build2 (MODIFY_EXPR, TREE_TYPE (tmp), tmp, + fold_convert (TREE_TYPE (tmp), + null_pointer_node)); + gfc_add_expr_to_block (&block, tmp); + continue; + } + field = cm->backend_decl; tmp = fold_build3 (COMPONENT_REF, TREE_TYPE (field), dest, field, NULL_TREE); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 3e992e3..fc9ee83 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2010-01-09 Tobias Burnus + + PR fortran/41298 + * gfortran.dg/c_ptr_tests_14.f90: New test. + 2010-01-08 Rainer Orth PR ada/41929 diff --git a/gcc/testsuite/gfortran.dg/c_ptr_tests_14.f90 b/gcc/testsuite/gfortran.dg/c_ptr_tests_14.f90 new file mode 100644 index 0000000..c4101fb --- /dev/null +++ b/gcc/testsuite/gfortran.dg/c_ptr_tests_14.f90 @@ -0,0 +1,51 @@ +! { dg-do run } +! { dg-options "-fdump-tree-original" } +! +! PR fortran/41298 +! +! Check that c_null_ptr default initializer is really applied + +module m + use iso_c_binding + type, public :: fgsl_file + type(c_ptr) :: gsl_file = c_null_ptr + type(c_funptr) :: gsl_func = c_null_funptr + type(c_ptr) :: NIptr + type(c_funptr) :: NIfunptr + end type fgsl_file +contains + subroutine sub(aaa,bbb) + type(fgsl_file), intent(out) :: aaa + type(fgsl_file), intent(inout) :: bbb + end subroutine + subroutine proc() bind(C) + end subroutine proc +end module m + +program test + use m + implicit none + type(fgsl_file) :: file, noreinit + integer, target :: tgt + + call sub(file, noreinit) + if(c_associated(file%gsl_file)) call abort() + if(c_associated(file%gsl_func)) call abort() + + file%gsl_file = c_loc(tgt) + file%gsl_func = c_funloc(proc) + call sub(file, noreinit) + if(c_associated(file%gsl_file)) call abort() + if(c_associated(file%gsl_func)) call abort() +end program test + +! { dg-final { scan-tree-dump-times "gsl_file = 0B" 1 "original" } } +! { dg-final { scan-tree-dump-times "gsl_func = 0B" 1 "original" } } + +! { dg-final { scan-tree-dump-times "NIptr = 0B" 0 "original" } } +! { dg-final { scan-tree-dump-times "NIfunptr = 0B" 0 "original" } } + +! { dg-final { scan-tree-dump-times "bbb =" 0 "original" } } + +! { dg-final { cleanup-tree-dump "original" } } +! { dg-final { cleanup-modules "m" } } -- 2.7.4