From: Thomas Koenig <tkoenig@gcc.gnu.org>
Date: Mon, 25 Jan 2021 19:18:14 +0000 (+0100)
Subject: Add test case for PR 96843.
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=a43e0dfb63ffb63e400b69acac6dd614b203d4fe;p=gcc.git

Add test case for PR 96843.

gcc/testsuite/ChangeLog:

	PR fortran/96843
	* gfortran.dg/interface_assignment_7.f90: New test.
---

diff --git a/gcc/testsuite/gfortran.dg/interface_assignment_7.f90 b/gcc/testsuite/gfortran.dg/interface_assignment_7.f90
new file mode 100644
index 00000000000..89e15e50168
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/interface_assignment_7.f90
@@ -0,0 +1,84 @@
+! { dg-do compile }
+! PR 96843 - this was wrongly rejected.
+! Test case by William Clodius.
+
+module test_shape_mismatch
+! Implements zero based bitsets of size up to HUGE(0_INT32).
+! The current code uses 32 bit integers to store the bits and uses all 32 bits.
+! The code assumes two's complement integers, and treats negative integers as
+! having the sign bit set.
+
+    use, intrinsic ::            &
+        iso_fortran_env, only:   &
+            bits_kind  => int32, &
+            block_kind => int64, &
+            int8,                &
+            dp => real64
+
+    implicit none
+
+    private
+
+    integer, parameter ::                                                     &
+        block_size  = bit_size(0_block_kind),                                 &
+        block_shift = int( ceiling( log( real(block_size, dp) )/log(2._dp) ) )
+
+    public :: bits_kind
+! Public constant
+
+    public :: bitset_t
+! Public type
+
+    public ::          &
+        assignment(=)
+
+    type, abstract :: bitset_t
+        private
+        integer(bits_kind) :: num_bits
+
+    end type bitset_t
+
+
+    type, extends(bitset_t) :: bitset_large
+        private
+        integer(block_kind), private, allocatable :: blocks(:)
+
+    end type bitset_large
+
+    interface assign
+
+        pure module subroutine assign_log8_large( self, alogical )
+!!     Used to define assignment from an array of type LOG for bitset_t
+            type(bitset_large), intent(out) :: self
+            logical(int8), intent(in) :: alogical(:)
+        end subroutine assign_log8_large
+
+    end interface assign
+
+contains
+
+    pure module subroutine assign_log8_large( self, alogical )
+!     Used to define assignment from an array of type LOG for bitset_t
+        type(bitset_large), intent(out) :: self
+        logical(int8), intent(in)  :: alogical(:)
+
+        integer(bits_kind) :: blocks
+        integer(bits_kind) :: log_size
+        integer(bits_kind) :: index
+
+        log_size = size( alogical, kind=bits_kind )
+        self % num_bits = log_size
+        if ( log_size == 0 ) then
+            blocks = 0
+
+        else
+            blocks = (log_size-1)/block_size + 1
+
+        end if
+        allocate( self % blocks( blocks ) )
+        self % blocks(:) = 0
+
+        return
+    end subroutine assign_log8_large
+
+end module test_shape_mismatch