OSDN Git Service

2011-10-14 Tobias Burnus <burnus@net-b.de>
authorburnus <burnus@138bc75d-0d04-0410-961f-82ee72b054a4>
Fri, 14 Oct 2011 15:09:21 +0000 (15:09 +0000)
committerburnus <burnus@138bc75d-0d04-0410-961f-82ee72b054a4>
Fri, 14 Oct 2011 15:09:21 +0000 (15:09 +0000)
        PR fortran/50718
        * trans-expr.c (gfc_conv_procedure_call): Fix -fcheck=pointer
        for dummy arguments with VALUE attribute.

2011-10-14  Tobias Burnus  <burnus@net-b.de>

        PR fortran/50718
        * gfortran.dg/pointer_check_11.f90: New.
        * gfortran.dg/pointer_check_12.f90: New.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@179988 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/fortran/ChangeLog
gcc/fortran/trans-expr.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/pointer_check_11.f90 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/pointer_check_12.f90 [new file with mode: 0644]

index 5e3d024..3cff8d7 100644 (file)
@@ -1,3 +1,9 @@
+2011-10-14  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/50718
+       * trans-expr.c (gfc_conv_procedure_call): Fix -fcheck=pointer
+       for dummy arguments with VALUE attribute.
+
 2011-10-11  Tobias Burnus  <burnus@net-b.de>
            Janus Weil  <janus@gcc.gnu.org>
 
index ca0523f..09b98d0 100644 (file)
@@ -3357,10 +3357,16 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
              else
                goto end_pointer_check;
 
+             tmp = parmse.expr;
+
+             /* If the argument is passed by value, we need to strip the
+                INDIRECT_REF.  */
+             if (!POINTER_TYPE_P (TREE_TYPE (parmse.expr)))
+               tmp = gfc_build_addr_expr (NULL_TREE, tmp);
 
              cond = fold_build2_loc (input_location, EQ_EXPR,
-                                     boolean_type_node, parmse.expr,
-                                     fold_convert (TREE_TYPE (parmse.expr),
+                                     boolean_type_node, tmp,
+                                     fold_convert (TREE_TYPE (tmp),
                                                    null_pointer_node));
            }
  
index e04f527..83d14d0 100644 (file)
@@ -1,3 +1,9 @@
+2011-10-14  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/50718
+       * gfortran.dg/pointer_check_11.f90: New.
+       * gfortran.dg/pointer_check_12.f90: New.
+
 2011-10-14  Paolo Carlini  <paolo.carlini@oracle.com>
 
        PR c++/38174
diff --git a/gcc/testsuite/gfortran.dg/pointer_check_11.f90 b/gcc/testsuite/gfortran.dg/pointer_check_11.f90
new file mode 100644 (file)
index 0000000..b6aa79a
--- /dev/null
@@ -0,0 +1,24 @@
+! { dg-do run }
+! { dg-options "-fcheck=all" }
+!
+! { dg-shouldfail "Pointer check" }
+! { dg-output "Fortran runtime error: Pointer actual argument 'y' is not associated" }
+!
+!
+! PR fortran/50718
+!
+! Was failing (ICE) with -fcheck=pointer if the dummy had the value attribute.
+
+type t
+  integer :: p
+end type t
+
+type(t), pointer :: y => null()
+
+call sub(y) ! Invalid: Nonassociated pointer
+
+contains
+  subroutine sub (x)
+    type(t), value :: x
+  end subroutine
+end
diff --git a/gcc/testsuite/gfortran.dg/pointer_check_12.f90 b/gcc/testsuite/gfortran.dg/pointer_check_12.f90
new file mode 100644 (file)
index 0000000..cfef70e
--- /dev/null
@@ -0,0 +1,22 @@
+! { dg-do run }
+! { dg-options "-fcheck=all" }
+!
+! { dg-shouldfail "Pointer check" }
+! { dg-output "Fortran runtime error: Pointer actual argument 'p' is not associated" }
+!
+! PR fortran/50718
+!
+! Was failing with -fcheck=pointer: Segfault at run time
+
+integer, pointer :: p => null()
+
+call sub2(%val(p)) ! Invalid: Nonassociated pointer
+end
+
+! Not quite correct dummy, but if one uses VALUE, gfortran
+! complains about a missing interface - which we cannot use
+! if we want to use %VAL().
+
+subroutine sub2(p)
+  integer :: p
+end subroutine sub2