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);

diff --git a/gcc/testsuite/gfortran.dg/c_ptr_tests_19.f90 b/gcc/testsuite/gfortran.dg/c_ptr_tests_19.f90

new file mode 100644

index 0000000..a50cd68

--- /dev/null

+++ b/gcc/testsuite/gfortran.dg/c_ptr_tests_19.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" } }