Blob Blame History Raw
From 40d6590b03a9f92c19b7097b1cae296276d6ce22 Mon Sep 17 00:00:00 2001
From: Jim MacArthur <jim.macarthur@codethink.co.uk>
Date: Mon, 28 Sep 2015 16:06:30 +0100
Subject: [PATCH 02/23] Pad character-to-int conversions with spaces instead of
 zeros.

The pad character is 'undefined' or 'processor dependent' depending on which
standard you read. This makes it 0x20 which matches the Oracle Fortran
compiler. One of the tests tests this undefined behaviour, so I had to modify
it.

    0002-Pad-character-to-int-conversions-with-spaces-instead.patch

diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt
index 4808c27..93908f8 100644
--- a/gcc/fortran/lang.opt
+++ b/gcc/fortran/lang.opt
@@ -428,6 +428,10 @@ fdec
 Fortran Var(flag_dec)
 Enable all DEC language extensions.
 
+fdec-pad-with-spaces
+Fortran Var(flag_dec_pad_with_spaces)
+For character to integer conversions, use spaces for the pad rather than NUL.
+
 fdec-intrinsic-ints
 Fortran Var(flag_dec_intrinsic_ints)
 Enable kind-specific variants of integer intrinsic functions.
diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index d12ae5f..09da1d2 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -6623,7 +6623,7 @@ gfc_simplify_transfer (gfc_expr *source, gfc_expr *mold, gfc_expr *size)
   /* Allocate the buffer to store the binary version of the source.  */
   buffer_size = MAX (source_size, result_size);
   buffer = (unsigned char*)alloca (buffer_size);
-  memset (buffer, 0, buffer_size);
+  memset (buffer, (flag_dec_pad_with_spaces ? 0x20 : 0x0), buffer_size);
 
   /* Now write source to the buffer.  */
   gfc_target_encode_expr (source, buffer, buffer_size);
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_ptr_tests_20.f90
@@ -0,0 +1,62 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-optimized -O -fdec-pad-with-spaces" }
+!
+! PR fortran/46974
+
+program test
+  use ISO_C_BINDING
+  implicit none
+  type(c_ptr) :: m
+  integer(c_intptr_t) :: a
+  integer(transfer(transfer(4_c_intptr_t, c_null_ptr),1_c_intptr_t)) :: b
+  a = transfer (transfer("ABCE", m), 1_c_intptr_t)
+  print '(z8)', a
+  if (     int(z'45434241') /= a  &
+     .and. int(z'41424345') /= a  &
+     .and. int(z'4142434520202020',kind=8) /= a &
+     .and. int(z'2020202045434241',kind=8) /= a ) &
+    call i_do_not_exist()
+end program test
+
+! Examples contributed by Steve Kargl and James Van Buskirk
+
+subroutine bug1
+   use ISO_C_BINDING
+   implicit none
+   type(c_ptr) :: m
+   type mytype
+     integer a, b, c
+   end type mytype
+   type(mytype) x
+   print *, transfer(32512, x)  ! Works.
+   print *, transfer(32512, m)  ! Caused ICE.
+end subroutine bug1 
+
+subroutine bug6
+   use ISO_C_BINDING
+   implicit none
+   interface
+      function fun()
+         use ISO_C_BINDING
+         implicit none
+         type(C_FUNPTR) fun
+      end function fun
+   end interface
+   type(C_PTR) array(2)
+   type(C_FUNPTR) result
+   integer(C_INTPTR_T), parameter :: const(*) = [32512,32520]
+
+   result = fun()
+   array = transfer([integer(C_INTPTR_T)::32512,32520],array)
+!   write(*,*) transfer(result,const)
+!   write(*,*) transfer(array,const)
+end subroutine bug6
+
+function fun()
+   use ISO_C_BINDING
+   implicit none
+   type(C_FUNPTR) fun
+   fun = transfer(32512_C_INTPTR_T,fun)
+end function fun 
+
+! { dg-final { scan-tree-dump-times "i_do_not_exist" 0 "optimized" } }