re PR fortran/91926 (assumed rank optional)
authorPaul Thomas <pault@gcc.gnu.org>
Sat, 5 Oct 2019 08:17:55 +0000 (08:17 +0000)
committerPaul Thomas <pault@gcc.gnu.org>
Sat, 5 Oct 2019 08:17:55 +0000 (08:17 +0000)
2019-10-05  Paul Thomas  <pault@gcc.gnu.org>

PR fortran/91926
* trans-expr.c (gfc_conv_gfc_desc_to_cfi_desc): Correct the
assignment of the attribute field to account correctly for an
assumed shape dummy. Assign separately to the gfc and cfi
descriptors since the atribute can be different. Add btanch to
correctly handle missing optional dummies.

2019-10-05  Paul Thomas  <pault@gcc.gnu.org>

PR fortran/91926
* gfortran.dg/ISO_Fortran_binding_13.f90 : New test.
* gfortran.dg/ISO_Fortran_binding_13.c : Additional source.
* gfortran.dg/ISO_Fortran_binding_14.f90 : New test.

2019-10-05  Paul Thomas  <pault@gcc.gnu.org>

PR fortran/91926
* runtime/ISO_Fortran_binding.c (cfi_desc_to_gfc_desc): Do not
modify the bounds and offset for CFI_other.

From-SVN: r276624

gcc/fortran/ChangeLog
gcc/fortran/trans-expr.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/ISO_Fortran_binding_13.c [new file with mode: 0644]
gcc/testsuite/gfortran.dg/ISO_Fortran_binding_13.f90 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/ISO_Fortran_binding_14.f90 [new file with mode: 0644]
libgfortran/ChangeLog
libgfortran/runtime/ISO_Fortran_binding.c

index dc1e19ac78bce50246edb48b2de137c43cdc3e71..2da44e0945247838335e38d41d3d6aad6270117a 100644 (file)
@@ -1,3 +1,12 @@
+2019-10-05  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/91926
+       * trans-expr.c (gfc_conv_gfc_desc_to_cfi_desc): Correct the
+       assignment of the attribute field to account correctly for an
+       assumed shape dummy. Assign separately to the gfc and cfi
+       descriptors since the atribute can be different. Add btanch to
+       correctly handle missing optional dummies.
+
 2019-10-04  Steven G. Kargl  <kargl@gcc.gnu.org>
 
        PR fortran.91959
@@ -65,7 +74,7 @@
        character types are possible it can get the character length from
        gfc_expr for character literals.
        (gfc_dummy_typename): New functionfor gfc_typespec *, if no character
-       length is present the character type is assumed and the appropriate 
+       length is present the character type is assumed and the appropriate
        string is return otherwise it calls gfc_typename for gfc_typespec *.
        (gfc_typespec): for character types construct the type name with length
        and kind (if it is not default kind).
index 61db4e39210c88f34d16ba2a08e3e19dfc5c70ec..965ab7786a1eaf4a085c7b12178c13477eb0c87f 100644 (file)
@@ -5202,7 +5202,9 @@ gfc_conv_gfc_desc_to_cfi_desc (gfc_se *parmse, gfc_expr *e, gfc_symbol *fsym)
   tree gfc_desc_ptr;
   tree type;
   tree cond;
+  tree desc_attr;
   int attribute;
+  int cfi_attribute;
   symbol_attribute attr = gfc_expr_attr (e);
   stmtblock_t block;
 
@@ -5211,12 +5213,20 @@ gfc_conv_gfc_desc_to_cfi_desc (gfc_se *parmse, gfc_expr *e, gfc_symbol *fsym)
   attribute = 2;
   if (!e->rank || gfc_get_full_arrayspec_from_expr (e))
     {
-      if (fsym->attr.pointer)
+      if (attr.pointer)
        attribute = 0;
-      else if (fsym->attr.allocatable)
+      else if (attr.allocatable)
        attribute = 1;
     }
 
+  /* If the formal argument is assumed shape and neither a pointer nor
+     allocatable, it is unconditionally CFI_attribute_other.  */
+  if (fsym->as->type == AS_ASSUMED_SHAPE
+      && !fsym->attr.pointer && !fsym->attr.allocatable)
+   cfi_attribute = 2;
+  else
+   cfi_attribute = attribute;
+
   if (e->rank != 0)
     {
       parmse->force_no_tmp = 1;
@@ -5283,11 +5293,12 @@ gfc_conv_gfc_desc_to_cfi_desc (gfc_se *parmse, gfc_expr *e, gfc_symbol *fsym)
                                                    parmse->expr, attr);
     }
 
-  /* Set the CFI attribute field.  */
-  tmp = gfc_conv_descriptor_attribute (parmse->expr);
+  /* Set the CFI attribute field through a temporary value for the
+     gfc attribute.  */
+  desc_attr = gfc_conv_descriptor_attribute (parmse->expr);
   tmp = fold_build2_loc (input_location, MODIFY_EXPR,
-                        void_type_node, tmp,
-                        build_int_cst (TREE_TYPE (tmp), attribute));
+                        void_type_node, desc_attr,
+                        build_int_cst (TREE_TYPE (desc_attr), cfi_attribute));
   gfc_add_expr_to_block (&parmse->pre, tmp);
 
   /* Now pass the gfc_descriptor by reference.  */
@@ -5305,6 +5316,12 @@ gfc_conv_gfc_desc_to_cfi_desc (gfc_se *parmse, gfc_expr *e, gfc_symbol *fsym)
                             gfor_fndecl_gfc_to_cfi, 2, tmp, gfc_desc_ptr);
   gfc_add_expr_to_block (&parmse->pre, tmp);
 
+  /* Now set the gfc descriptor attribute.  */
+  tmp = fold_build2_loc (input_location, MODIFY_EXPR,
+                        void_type_node, desc_attr,
+                        build_int_cst (TREE_TYPE (desc_attr), attribute));
+  gfc_add_expr_to_block (&parmse->pre, tmp);
+
   /* The CFI descriptor is passed to the bind_C procedure.  */
   parmse->expr = cfi_desc_ptr;
 
@@ -5325,6 +5342,25 @@ gfc_conv_gfc_desc_to_cfi_desc (gfc_se *parmse, gfc_expr *e, gfc_symbol *fsym)
   tmp = build_call_expr_loc (input_location,
                             gfor_fndecl_cfi_to_gfc, 2, gfc_desc_ptr, tmp);
   gfc_prepend_expr_to_block (&parmse->post, tmp);
+
+  /* Deal with an optional dummy being passed to an optional formal arg
+     by finishing the pre and post blocks and making their execution
+     conditional on the dummy being present.  */
+  if (fsym->attr.optional && e->expr_type == EXPR_VARIABLE
+      && e->symtree->n.sym->attr.optional)
+    {
+      cond = gfc_conv_expr_present (e->symtree->n.sym);
+      tmp = fold_build2 (MODIFY_EXPR, void_type_node,
+                        cfi_desc_ptr,
+                        build_int_cst (pvoid_type_node, 0));
+      tmp = build3_v (COND_EXPR, cond,
+                     gfc_finish_block (&parmse->pre), tmp);
+      gfc_add_expr_to_block (&parmse->pre, tmp);
+      tmp = build3_v (COND_EXPR, cond,
+                     gfc_finish_block (&parmse->post),
+                     build_empty_stmt (input_location));
+      gfc_add_expr_to_block (&parmse->post, tmp);
+    }
 }
 
 
index 8a0a03526e77c53eae3164b7e948f26e39364704..e40a167a5518f03b535786109f8be07210380511 100644 (file)
@@ -1,3 +1,10 @@
+2019-10-05  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/91926
+       * gfortran.dg/ISO_Fortran_binding_13.f90 : New test.
+       * gfortran.dg/ISO_Fortran_binding_13.c : Additional source.
+       * gfortran.dg/ISO_Fortran_binding_14.f90 : New test.
+
 2019-10-05  Jakub Jelinek  <jakub@redhat.com>
 
        PR c++/91369 - Implement P0784R7: constexpr new
diff --git a/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_13.c b/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_13.c
new file mode 100644 (file)
index 0000000..1ac9fc8
--- /dev/null
@@ -0,0 +1,12 @@
+/* Test the fix for PR91926.  */
+
+/* Contributed by José Rui Faustino de Sousa  <jrfsousa@hotmail.com> */
+
+#include <stdlib.h>
+
+int ifb_echo(void*);
+
+int ifb_echo(void *this)
+{
+  return this == NULL ? 1 : 2;
+}
diff --git a/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_13.f90 b/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_13.f90
new file mode 100644 (file)
index 0000000..132a97c
--- /dev/null
@@ -0,0 +1,39 @@
+! { dg-do run { target c99_runtime } }
+! { dg-additional-sources ISO_Fortran_binding_13.c }
+!
+! Test the fix for PR91926. The additional source is the main program.
+!
+! Contributed by José Rui Faustino de Sousa  <jrfsousa@hotmail.com>
+!
+program ifb_p
+
+  implicit none
+
+  integer :: i = 42
+
+  interface
+    integer function ifb_echo_aux(this) bind(c, name="ifb_echo")
+      implicit none
+      type(*), dimension(..), & ! removing assumed rank solves segmentation fault
+        optional, intent(in) :: this
+    end function ifb_echo_aux
+  end interface
+
+  if (ifb_echo_aux() .ne. 1) STOP 1  ! worked
+  if (ifb_echo() .ne. 1) stop 2      ! segmentation fault
+  if (ifb_echo_aux(i) .ne. 2) stop 3 ! worked
+  if (ifb_echo(i) .ne. 2) stop 4     ! worked
+
+  stop
+
+contains
+
+  integer function ifb_echo(this)
+    type(*), dimension(..), &
+      optional, intent(in) :: this
+
+    ifb_echo = ifb_echo_aux(this)
+    return
+  end function ifb_echo
+
+end program ifb_p
diff --git a/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_14.f90 b/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_14.f90
new file mode 100644 (file)
index 0000000..388c543
--- /dev/null
@@ -0,0 +1,41 @@
+! { dg-do run }
+!
+! Correct an error in the eveluation of the CFI descriptor attribute for
+! the case where the bind_C formal argument is not an assumed shape array
+! and not allocatable or pointer.
+!
+! Contributed by Gilles Gouaillardet  <gilles@rist.or.jp>
+!
+MODULE FOO
+INTERFACE
+SUBROUTINE dummy(buf) BIND(C, name="sync")
+type(*), dimension(..) :: buf
+END SUBROUTINE
+END INTERFACE
+END MODULE
+
+PROGRAM main
+    USE FOO
+    IMPLICIT NONE
+    integer(8) :: before, after
+
+    INTEGER, parameter :: n = 1
+
+    INTEGER, ALLOCATABLE :: buf(:)
+    INTEGER :: buf2(n)
+    INTEGER :: i
+
+    ALLOCATE(buf(n))
+    before = LOC(buf(1))
+    CALL dummy (buf)
+    after = LOC(buf(1))
+
+    if (before .NE. after) stop 1
+
+    before = LOC(buf2(1))
+    CALL dummy (buf)
+    after = LOC(buf2(1))
+
+    if (before .NE. after) stop 2
+
+END PROGRAM
index 3f69e567ef7701dc3482c3d03d1a0352955f9795..7736e5da937564d8be80b1d6f1093de211d91e88 100644 (file)
@@ -1,3 +1,9 @@
+2019-10-05  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/91926
+       * runtime/ISO_Fortran_binding.c (cfi_desc_to_gfc_desc): Do not
+       modify the bounds and offset for CFI_other.
+
 2019-10-01  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
        PR libfortran/91593
@@ -14,7 +20,7 @@
        formatted_transfer_scalar_read, formatted_transfer_scalar_write,
        pre_position, next_record_r, next_record_w): Add and use
        FORMATTED_UNSPECIFIED to enumeration.
-       
+
 2019-09-27  Maciej W. Rozycki  <macro@wdc.com>
 
        * configure: Regenerate.
index 695ef57ac32977455ff2980c5cbe139b14d64f45..8cfcc98965e498e4e79f9efc412489b904ebadca 100644 (file)
@@ -63,7 +63,8 @@ cfi_desc_to_gfc_desc (gfc_array_void *d, CFI_cdesc_t **s_ptr)
   d->dtype.version = s->version;
   GFC_DESCRIPTOR_RANK (d) = (signed char)s->rank;
 
-  d->dtype.attribute = (signed short)s->attribute;
+  if (d->dtype.attribute == CFI_attribute_other)
+    return;
 
   if (s->rank)
     {