
#!/bin/sh
# -copyright-
#-# Copyright: 2015-2025 Willem Vermin wvermin@gmail.com
#-# 
#-# License: BSD-3-Clause
#-#  Redistribution and use in source and binary forms, with or without
#-#  modification, are permitted provided that the following conditions
#-#  are met:
#-#  1. Redistributions of source code must retain the above copyright
#-#     notice, this list of conditions and the following disclaimer.
#-#  2. Redistributions in binary form must reproduce the above copyright
#-#     notice, this list of conditions and the following disclaimer in the
#-#     documentation and/or other materials provided with the distribution.
#-#  3. Neither the name of the copyright holder nor the names of its
#-#     contributors may be used to endorse or promote products derived
#-#     from this software without specific prior written permission.
#-#   
#-#  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
#-#  "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
#-#  LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
#-#  A PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE HOLDERS OR
#-#  CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
#-#  EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
#-#  PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
#-#  PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
#-#  LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
#-#  NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
#-#  SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

# testing STRUCTURE UNION MAP

if test -e prelude ; then
   . ./prelude
else
   . ./debian/tests/prelude
fi
rc=0
cat << eof > prog
PROGRAM TYPE_bug
structure /reg/
union ! U0                ! rax
map
character(16) rx
end map
map
character(8) rh         ! rah
union ! U1
map
character(8) rl     ! ral
end map
map
character(8) ex     ! eax
end map
map
character(4) eh     ! eah
union ! U2
map
character(4) el ! eal
end map
map
character(4) x  ! ax
end map
map
character(2) h  ! ah
character(2) l  ! al
end map
end union
end map
end union
end map
end union
end structure
record /reg/ a

STRUCTURE /s/
  INTEGER :: i = 2
END STRUCTURE
RECORD /s/ :: TYPES_MESH

a.rl = 'x'
IF ( TYPES_MESH.i == 1 ) THEN
  TYPES_MESH.i = 11
ELSE IF ( TYPES_MESH.i == 2 ) THEN
  TYPES_MESH.i = 22
ELSE IF ( TYPES_MESH.i == 3 ) THEN
  TYPES_MESH.i = 33
END IF
PRINT *, TYPES_MESH
END PROGRAM
eof
cat << eof > expect
PROGRAM TYPE_bug
   structure /reg/
      union ! U0                ! rax
         map
            character(16) rx
         end map
         map
            character(8) rh         ! rah
            union ! U1
               map
                  character(8) rl     ! ral
               end map
               map
                  character(8) ex     ! eax
               end map
               map
                  character(4) eh     ! eah
                  union ! U2
                     map
                        character(4) el ! eal
                     end map
                     map
                        character(4) x  ! ax
                     end map
                     map
                        character(2) h  ! ah
                        character(2) l  ! al
                     end map
                  end union
               end map
            end union
         end map
      end union
   end structure
   record /reg/ a

   STRUCTURE /s/
      INTEGER :: i = 2
   END STRUCTURE
   RECORD /s/ :: TYPES_MESH

   a.rl = 'x'
   IF ( TYPES_MESH.i == 1 ) THEN
      TYPES_MESH.i = 11
   ELSE IF ( TYPES_MESH.i == 2 ) THEN
      TYPES_MESH.i = 22
   ELSE IF ( TYPES_MESH.i == 3 ) THEN
      TYPES_MESH.i = 33
   END IF
   PRINT *, TYPES_MESH
END PROGRAM
eof
../doit  "-ifree" "Test001: STRUCTURE UNION MAP free"
rc=`expr $rc + $?`

. ../postlude
exit $rc
# vim: indentexpr=none
