[Bug fortran/40605] New: -fcheck=pointer: Problems with OPTIONAL

[Bug fortran/40605] New: -fcheck=pointer: Problems with OPTIONAL

[burnus at gcc dot gnu dot org]

-fcheck=pointer gives a segfault for a not present actual argument. Fix:

+++ trans-expr.c        (working copy)
@@ -2778 +2778 @@ gfc_conv_procedure_call (gfc_se * se, gf
-      if (gfc_option.rtcheck & GFC_RTCHECK_POINTER)
+      if (gfc_option.rtcheck & GFC_RTCHECK_POINTER && e != NULL)

Test case:

      SUBROUTINE rw_inp(scpos)
      IMPLICIT NONE
      REAL scpos

      interface
        FUNCTION evaluateFirst(s,n)result(number)
          IMPLICIT NONE
          CHARACTER(len =*), INTENT(inout) :: s
          INTEGER,OPTIONAL                 :: n
          REAL                             :: number
        end function
      end interface

      CHARACTER(len=100) :: line
      scpos = evaluatefirst(line)
      END SUBROUTINE rw_inp


-- 
           Summary: -fcheck=pointer: Problems with OPTIONAL
           Product: gcc
           Version: 4.5.0
            Status: UNCONFIRMED
          Keywords: ice-on-valid-code
          Severity: normal
          Priority: P3
         Component: fortran
        AssignedTo: unassigned at gcc dot gnu dot org
        ReportedBy: burnus at gcc dot gnu dot org


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=40605

[Bug fortran/40605] -fcheck=pointer: Problems with OPTIONAL

[burnus at gcc dot gnu dot org]

------- Comment #1 from burnus at gcc dot gnu dot org  2009-07-01 13:02 -------
*** Bug 40604 has been marked as a duplicate of this bug. ***


-- 

burnus at gcc dot gnu dot org changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
                 CC|                            |janus at gcc dot gnu dot org


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=40605

[Bug fortran/40605] -fcheck=pointer: Problems with OPTIONAL

[janus at gcc dot gnu dot org]

------- Comment #2 from janus at gcc dot gnu dot org  2009-07-01 13:16 -------
Here is another test case which segfaults with -fcheck=pointer, even with the
fix from comment #0:

module m

  Interface matrixMult
     Module procedure matrixMult_C2
  End Interface

contains

  subroutine test
    implicit none
    complex, dimension(0:3,0:3) :: m1,m2
    print *,Trace(MatrixMult(m1,m2))
  end subroutine

  complex function trace(a)
    implicit none
    complex, intent(in),  dimension(0:3,0:3) :: a 
  end function trace

  function matrixMult_C2(a,b) result(matrix)
    implicit none
    complex, dimension(0:3,0:3) :: matrix,a,b
  end function matrixMult_C2

end


-- 

janus at gcc dot gnu dot org changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
             Status|UNCONFIRMED                 |NEW
     Ever Confirmed|0                           |1
   Last reconfirmed|0000-00-00 00:00:00         |2009-07-01 13:16:43
               date|                            |


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=40605

[Bug fortran/40605] -fcheck=pointer: Problems with OPTIONAL

[burnus at gcc dot gnu dot org]

------- Comment #3 from burnus at gcc dot gnu dot org  2009-07-01 13:40 -------
But of cause also the run-time test fails; for absent arguments a NULL is
passed.

We need to check:
a) optional pointer actual to non-optional dummy
b) optional pointer actual to optional dummy

The -fcheck=pointer specific check would be to check for
 "*actual == NULL"
though that needs to be guarded by "actual != NULL".

In general, passing a not-present optional to a non-optional dummy should be
checked somewhere; the question is with which option (-fcheck=call?).

Patch below.
(Note: One has to use TRUTH_ANDIF_EXPR and not TRUTH_AND_EXPR!)

--- trans-expr.c        (revision 149129)
+++ trans-expr.c        (working copy)
@@ -2778 +2778 @@ gfc_conv_procedure_call (gfc_se * se, gf
-      if (gfc_option.rtcheck & GFC_RTCHECK_POINTER)
+      if (gfc_option.rtcheck & GFC_RTCHECK_POINTER && e != NULL)
@@ -2806 +2806,15 @@ gfc_conv_procedure_call (gfc_se * se, gf
-         cond  = fold_build2 (EQ_EXPR, boolean_type_node, parmse.expr,
+          if (sym->attr.optional)
+           {
+             tree present, nullptr, type;
+             type = TREE_TYPE (parmse.expr);
+              present = fold_build2 (NE_EXPR, boolean_type_node, parmse.expr,
+                                    fold_convert (type, null_pointer_node));
+             type = TREE_TYPE (type);
+             nullptr = fold_build2 (EQ_EXPR, boolean_type_node,
+                                    build1 (INDIRECT_REF, type, parmse.expr),
+                                    fold_convert (type, null_pointer_node));
+             cond = fold_build2 (TRUTH_ANDIF_EXPR, boolean_type_node,
+                                 present, nullptr);
+           }
+          else
+          cond = fold_build2 (EQ_EXPR, boolean_type_node, parmse.expr,


-- 

burnus at gcc dot gnu dot org changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
         AssignedTo|unassigned at gcc dot gnu   |burnus at gcc dot gnu dot
                   |dot org                     |org
             Status|NEW                         |ASSIGNED
   Last reconfirmed|2009-07-01 13:16:43         |2009-07-01 13:40:51
               date|                            |


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=40605

[Bug fortran/40605] -fcheck=pointer: Problems with OPTIONAL

[burnus at gcc dot gnu dot org]

------- Comment #4 from burnus at gcc dot gnu dot org  2009-07-01 14:37 -------
The generic interface problem should be fixed by the following, which includes
the bits from the others patches:

--- trans-expr.c        (revision 149129)
+++ trans-expr.c        (working copy)
@@ -2778 +2778 @@ gfc_conv_procedure_call (gfc_se * se, gf
-      if (gfc_option.rtcheck & GFC_RTCHECK_POINTER)
+      if (gfc_option.rtcheck & GFC_RTCHECK_POINTER && e != NULL)
@@ -2780 +2780 @@ gfc_conv_procedure_call (gfc_se * se, gf
-         gfc_symbol *sym;
+         symbol_attribute *attr;
@@ -2785 +2785 @@ gfc_conv_procedure_call (gfc_se * se, gf
-           sym = e->symtree->n.sym;
+           attr = &e->symtree->n.sym->attr;
@@ -2787 +2787,10 @@ gfc_conv_procedure_call (gfc_se * se, gf
-           sym = e->symtree->n.sym->result;
+           {
+             /* For intrinsic functions, the gfc_attr are not available.  */
+             if (e->symtree->n.sym->attr.generic && e->value.function.isym)
+               goto end_pointer_check;
+
+             if (e->symtree->n.sym->attr.generic)
+               attr = &e->value.function.esym->result->attr;
+             else
+               attr = &e->symtree->n.sym->result->attr;
+           }
@@ -2791 +2800 @@ gfc_conv_procedure_call (gfc_se * se, gf
-         if (sym->attr.allocatable
+         if (attr->allocatable
@@ -2794,2 +2803,2 @@ gfc_conv_procedure_call (gfc_se * se, gf
-                     "allocated", sym->name);
-         else if (sym->attr.pointer
+                     "allocated", e->symtree->n.sym->name);
+         else if (attr->pointer
@@ -2798,2 +2807,2 @@ gfc_conv_procedure_call (gfc_se * se, gf
-                     "associated", sym->name);
-          else if (sym->attr.proc_pointer
+                     "associated", e->symtree->n.sym->name);
+          else if (attr->proc_pointer
@@ -2802 +2811 @@ gfc_conv_procedure_call (gfc_se * se, gf
-                     "associated", sym->name);
+                     "associated", e->symtree->n.sym->name);
@@ -2806 +2815,15 @@ gfc_conv_procedure_call (gfc_se * se, gf
-         cond  = fold_build2 (EQ_EXPR, boolean_type_node, parmse.expr,
+          if (sym->attr.optional)
+           {
+             tree present, nullptr, type;
+             type = TREE_TYPE (parmse.expr);
+              present = fold_build2 (NE_EXPR, boolean_type_node, parmse.expr,
+                                    fold_convert (type, null_pointer_node));
+             type = TREE_TYPE (type);
+             nullptr = fold_build2 (EQ_EXPR, boolean_type_node,
+                                    build1 (INDIRECT_REF, type, parmse.expr),
+                                    fold_convert (type, null_pointer_node));
+             cond = fold_build2 (TRUTH_ANDIF_EXPR, boolean_type_node,
+                                 present, nullptr);
+           }
+          else
+          cond = fold_build2 (EQ_EXPR, boolean_type_node, parmse.expr,


-- 


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=40605

[Bug fortran/40605] -fcheck=pointer: Problems with OPTIONAL

[burnus at gcc dot gnu dot org]

------- Comment #5 from burnus at gcc dot gnu dot org  2009-07-01 16:09 -------
Another failure - this time for __convert_i4_r4 (a EXPR_FUNCTION) as actual
argument, which does not set sym->result ...

Test case:

      SUBROUTINE plotdop(amat)
      IMPLICIT NONE
      REAL,    INTENT (IN) :: amat(3,3)
      integer :: i1
      real :: pt(3)
      i1 = 1
      pt = MATMUL(amat,(/i1,i1,i1/))
      END SUBROUTINE plotdop

Patch:

--- intrinsic.c (revision 149129)
+++ intrinsic.c (working copy)
@@ -3996,0 +3997 @@ gfc_convert_type_warn (gfc_expr *expr, g
+  new_expr->symtree->n.sym->result = new_expr->symtree->n.sym;


-- 


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=40605

[Bug fortran/40605] -fcheck=pointer: Problems with OPTIONAL

[burnus at gcc dot gnu dot org]

------- Comment #6 from burnus at gcc dot gnu dot org  2009-07-09 09:57 -------
FIXED on the trunk (4.5). The commit message only made it to PR 40604 as I
forgot about PR 40605 ...


Subject: Bug 40604

Author: burnus
Date: Thu Jul  9 09:42:34 2009
New Revision: 149405

URL: http://gcc.gnu.org/viewcvs?root=gcc&view=rev&rev=149405
Log:
2009-07-09  Tobias Burnus  <burnus@net-b.de>

        PR fortran/40604
        * intrinsic.c (gfc_convert_type_warn): Set sym->result.
        * trans-expr.c (gfc_conv_procedure_call): Fix -fcheck=pointer
        for optional arguments.

2009-07-09  Tobias Burnus  <burnus@net-b.de>

        PR fortran/40604
        * gfortran.dg/pointer_check_6.f90: New test.


Added:
    trunk/gcc/testsuite/gfortran.dg/pointer_check_6.f90
Modified:
    trunk/gcc/fortran/ChangeLog
    trunk/gcc/fortran/intrinsic.c
    trunk/gcc/fortran/trans-expr.c
    trunk/gcc/testsuite/ChangeLog


-- 

burnus at gcc dot gnu dot org changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
             Status|ASSIGNED                    |RESOLVED
         Resolution|                            |FIXED


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=40605