[multiple changes]

2010-01-09  Tobias Burnus  <burnus@net-b.de>                                      

        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  <burnus@net-b.de>

        PR fortran/41298
        * gfortran.dg/c_ptr_tests_14.f90: New test.

From-SVN: r155755

gcc/fortran/ChangeLog

@@ -1,3 +1,13 @@
+2010-01-09  Tobias Burnus  <burnus@net-b.de>
+
+	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  <jakub@redhat.com>
 
 	* gfortranspec.c (lang_specific_driver): Update copyright notice

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;

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;

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 <paul@nowt.org>
    and Steven Bosscher <s.bosscher@student.tudelft.nl>
@@ -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);

gcc/testsuite/ChangeLog

@@ -1,3 +1,8 @@
+2010-01-09  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/41298
+	* gfortran.dg/c_ptr_tests_14.f90: New test.
+
 2010-01-08  Rainer Orth  <ro@CeBiTec.Uni-Bielefeld.DE>
 
 	PR ada/41929

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" } }