re PR fortran/56226 (Add support for DEC UNION and MAP extensions)

2016-05-07  Fritz Reese  <fritzoreese@gmail.com>

	PR fortran/56226
	* module.c (dt_upper_string): Rename to gfc_dt_upper_string
	(dt_lower_string): Likewise.
	* gfortran.h: Make new gfc_dt_upper/lower_string global.
	* class.c: Use gfc_dt_upper_string.
	* decl.c: Likewise.
	* symbol.c: Likewise.
	* resolve.c (resolve_component): New function.
	(resolve_fl_derived0): Move component loop code to resolve_component.
	* parse.c (check_component): New function.
	(parse_derived): Move loop code to check_component.
	* lang.opt, invoke.texi, options.c : New option -fdec-structure.
	* libgfortran.h (bt): New basic type BT_UNION.
	* gfortran.h (gfc_option): New option -fdec-structure.
	(gfc_get_union_type, gfc_compare_union_types): New prototypes.
	(gfc_bt_struct, gfc_fl_struct, case_bt_struct, case_fl_struct): New
	macros.
	(gfc_find_component): Change prototype.
	* match.h (gfc_match_member_sep, gfc_match_map, gfc_match_union,
	gfc_match_structure_decl): New prototypes.
	* parse.h (gfc_comp_struct): New macro.
	* symbol.c (gfc_find_component): Search for components in nested unions
	* class.c (insert_component_ref, gfc_add_component_ref, add_proc_comp,
	copy_vtab_proc_comps): Update calls to gfc_find_component.
	* primary.c (gfc_convert_to_structure_constructor): Likewise.
	* symbol.c (gfc_add_component): Likewise.
	* resolve.c (resolve_typebound_function, resolve_typebound_subroutine,
	resolve_typebound_procedure, resolve_component, resolve_fl_derived):
	Likewise.
	* expr.c (get_union_init, component_init): New functions.
	* decl.c (match_clist_expr, match_record_decl, get_struct_decl,
	gfc_match_map, gfc_match_union, gfc_match_structure_decl): Likewise.
	* interface.c (compare_components, gfc_compare_union_types): Likewise.
	* match.c (gfc_match_member_sep): Likewise.
	* parse.c (check_component, parse_union, parse_struct_map): Likewise.
	* resolve.c (resolve_fl_struct): Likewise.
	* symbol.c (find_union_component): Likewise.
	* trans-types.c (gfc_get_union_type): Likewise.
	* parse.c (parse_derived): Use new functions.
	* interface.c (gfc_compare_derived_types, gfc_compare_types): Likewise.
	* expr.c (gfc_default_initializer): Likewise.
	* gfortran.texi: Support for DEC structures, unions, and maps.
	* gfortran.h (gfc_statement, sym_flavor): Likewise.
	* check.c (gfc_check_kill_sub): Likewise.
	* expr.c (gfc_copy_expr, simplify_const_ref,
	gfc_has_default_initializer): Likewise.
	* decl.c (build_sym, match_data_constant, add_init_expr_to_sym,
	match_pointer_init, build_struct, variable_decl,
	gfc_match_decl_type_spec, gfc_mach_data-decl, gfc_match_entry,
	gfc_match_end, gfc_match_derived_decl): Likewise.
	* interface.c (check_interface0, check_interface1,
	gfc_search_interface): Likewise.
	* misc.c (gfc_basic_typename, gfc_typename): Likewise.
	* module.c (add_true_name, build_tnt, bt_types, mio_typespec,
	fix_mio_expr, load_needed, mio_symbol, read_module, write_symbol,
	gfc_get_module_backend_decl): Likewise.
	* parse.h (gfc_compile_state): Likewise.
	* parse.c (decode_specification_statement, decode_statement,
	gfc_ascii_statement, verify_st_order, parse_spec): Likewise.
	* primary.c (gfc_match_varspec, gfc_match_structure_constructor,
	gfc_match_rvalue, match_variable): Likewise.
	* resolve.c (find_arglists, resolve_structure_cons,
	is_illegal_recursion, resolve_generic_f, get_declared_from_expr,
	resolve_typebound_subroutine, resolve_allocate_expr,
	nonscalar_typebound_assign, generate_component_assignments,
	resolve_fl_variable_derived, check_defined_assignments,
	resolve_component, resolve_symbol, resolve_equivalence_derived):
	Likewise.
	* symbol.c (flavors, check_conflict, gfc_add_flavor, gfc_use_derived,
	gfc_restore_last_undo_checkpoint, gfc_type_compatible,
	gfc_find_dt_in_generic): Likewise.
	* trans-decl.c (gfc_get_module_backend_decl, create_function_arglist,
	gfc_create_module_variable, check_constant_initializer): Likewise.
	* trans-expr.c (gfc_conv_component_ref, gfc_conv_initializer,
	gfc_trans_alloc_subarray_assign, gfc_trans_subcomponent_assign,
	gfc_conv_structure, gfc_trans_scalar_assign, copyable_array_p):
	Likewise.
	* trans-io.c (transfer_namelist_element, transfer_expr,
	gfc_trans_transfer): Likewise.
	* trans-stmt.c (gfc_trans_deallocate): Likewise.
	* trans-types.c (gfc_typenode_for_spec, gfc_copy_dt_decls_ifequal,
	gfc_get_derived_type): Likewise.

2016-05-07  Fritz Reese  <fritzoreese@gmail.com>

	PR fortran/56226
	* gfortran.dg/dec_structure_1.f90: New testcase.
	* gfortran.dg/dec_structure_2.f90: Ditto.
	* gfortran.dg/dec_structure_3.f90: Ditto.
	* gfortran.dg/dec_structure_4.f90: Ditto.
	* gfortran.dg/dec_structure_5.f90: Ditto.
	* gfortran.dg/dec_structure_6.f90: Ditto.
	* gfortran.dg/dec_structure_7.f90: Ditto.
	* gfortran.dg/dec_structure_8.f90: Ditto.
	* gfortran.dg/dec_structure_9.f90: Ditto.
	* gfortran.dg/dec_structure_10.f90: Ditto.
	* gfortran.dg/dec_structure_11.f90: Ditto.
	* gfortran.dg/dec_union_1.f90: Ditto.
	* gfortran.dg/dec_union_2.f90: Ditto.
	* gfortran.dg/dec_union_3.f90: Ditto.
	* gfortran.dg/dec_union_4.f90: Ditto.
	* gfortran.dg/dec_union_5.f90: Ditto.
	* gfortran.dg/dec_union_6.f90: Ditto.
	* gfortran.dg/dec_union_7.f90: Ditto.

From-SVN: r235999

19 files changed, 986 insertions, 0 deletions

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 585839c..aab13e4 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,25 @@
+2016-05-07  Fritz Reese  <fritzoreese@gmail.com>
+
+	PR fortran/56226
+	* gfortran.dg/dec_structure_1.f90: New testcase.
+	* gfortran.dg/dec_structure_2.f90: Ditto.
+	* gfortran.dg/dec_structure_3.f90: Ditto.
+	* gfortran.dg/dec_structure_4.f90: Ditto.
+	* gfortran.dg/dec_structure_5.f90: Ditto.
+	* gfortran.dg/dec_structure_6.f90: Ditto.
+	* gfortran.dg/dec_structure_7.f90: Ditto.
+	* gfortran.dg/dec_structure_8.f90: Ditto.
+	* gfortran.dg/dec_structure_9.f90: Ditto.
+	* gfortran.dg/dec_structure_10.f90: Ditto.
+	* gfortran.dg/dec_structure_11.f90: Ditto.
+	* gfortran.dg/dec_union_1.f90: Ditto.
+	* gfortran.dg/dec_union_2.f90: Ditto.
+	* gfortran.dg/dec_union_3.f90: Ditto.
+	* gfortran.dg/dec_union_4.f90: Ditto.
+	* gfortran.dg/dec_union_5.f90: Ditto.
+	* gfortran.dg/dec_union_6.f90: Ditto.
+	* gfortran.dg/dec_union_7.f90: Ditto.
+
 2016-05-07  Tom de Vries  <tom@codesourcery.com>
 
 	PR tree-optimization/70956
diff --git a/gcc/testsuite/gfortran.dg/dec_structure_1.f90 b/gcc/testsuite/gfortran.dg/dec_structure_1.f90
new file mode 100644
index 0000000..4dfee3c6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_structure_1.f90
@@ -0,0 +1,56 @@
+! { dg-do run }
+! { dg-options "-fdec-structure" }
+!
+! Basic STRUCTURE test.
+!
+
+subroutine aborts (s)
+  character(*), intent(in) :: s
+  print *, s
+  call abort()
+end subroutine
+
+! Basic structure
+structure /s1/                ! type s1
+  integer i1
+  logical l1
+  real r1
+  character c1
+end structure                 ! end type s1
+
+record /s1/ r1                ! type (s1) r1
+record /s1/ r1_a(3)           ! type (s1) r1_a(3)
+
+! Basic records
+r1.i1 = 13579                  ! r1%i1 = ...
+r1.l1 = .true.
+r1.r1 = 13.579
+r1.c1 = 'F'
+r1_a(2) = r1
+r1_a(3).r1 = 135.79
+
+if (r1.i1 .ne. 13579) then
+  call aborts("r1.i1")
+endif
+
+if (r1.l1 .neqv. .true.) then
+  call aborts("r1.l1")
+endif
+
+if (r1.r1 .ne. 13.579) then
+  call aborts("r1.r1")
+endif
+
+if (r1.c1 .ne. 'F') then
+  call aborts("r1.c1")
+endif
+
+if (r1_a(2).i1 .ne. 13579) then
+  call aborts("r1_a(2).i1")
+endif
+
+if (r1_a(3).r1 .ne. 135.79) then
+  call aborts("r1_a(3).r1")
+endif
+
+end
diff --git a/gcc/testsuite/gfortran.dg/dec_structure_10.f90 b/gcc/testsuite/gfortran.dg/dec_structure_10.f90
new file mode 100644
index 0000000..2d92b1a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_structure_10.f90
@@ -0,0 +1,119 @@
+! { dg-do run }
+! { dg-options "-fdec-structure" }
+!
+! Runtime tests for rules governing dot ('.') as a member accessor, including
+! voodoo with aliased user-defined vs. intrinsic operators and nested members.
+! See gcc/fortran/match.c (gfc_match_member_sep).
+!
+
+module dec_structure_10
+  ! Operator overload tests with .ne. and constant member
+  structure /s1/
+    integer i
+    integer ne
+    logical b
+  end structure
+
+  ! Operator overload tests with .eq., .test. and nested members
+  structure /s2/
+    record /s1/ eq
+    record /s1/ test
+    record /s1/ and
+    integer i
+  end structure
+
+  ! Deep nested access tests
+  structure /s3/
+    record /s2/ r2
+  end structure
+  structure /s4/
+    record /s3/ r3
+  end structure
+  structure /s5/
+    record /s4/ r4
+  end structure
+  structure /s6/
+    record /s5/ r5
+  end structure
+  structure /s7/
+    record /s6/ r6
+  end structure
+
+  ! Operator overloads to mess with nested member accesses
+  interface operator (.ne.)
+    module procedure ne_func
+  end interface operator (.ne.)
+  interface operator (.eq.)
+    module procedure eq_func
+  end interface operator (.eq.)
+  interface operator (.test.)
+    module procedure tstfunc
+  end interface operator (.test.)
+  contains
+  ! ne_func will be called on (x) .ne. (y)
+  function ne_func (r, i)
+    integer, intent(in) :: i
+    type(s1), intent(in) :: r
+    integer ne_func
+    ne_func = r%i + i
+  end function
+  ! eq_func will be called on (x) .eq. (y)
+  function eq_func (r, i)
+    integer, intent(in) :: i
+    type(s2), intent(in) :: r
+    integer eq_func
+    eq_func = r%eq%i + i
+  end function eq_func
+  ! tstfunc will be called on (x) .test. (y)
+  function tstfunc (r, i)
+    integer, intent(in) :: i
+    type(s2), intent(in) :: r
+    integer tstfunc
+    tstfunc = r%i + i
+  end function tstfunc
+end module
+
+use dec_structure_10
+
+record /s1/ r
+record /s2/ struct
+record /s7/ r7
+integer i, j
+logical l
+struct%eq%i = 5
+i = -5
+
+! Nested access: struct has a member and which has a member b
+l =  struct .and. b   ! struct%and%b
+l =  struct .and. b .or. .false. ! (struct%and%b) .or. (.false.)
+
+! Intrinsic op: r has no member 'ne'
+j =  r .ne. i         ! <intrinsic> ne(r, i)
+j = (r) .ne. i        ! <intrinsic> ne(r, i)
+
+! Intrinsic op; r has a member 'ne' but it is not a record
+j =  r .ne. i         ! <intrinsic> ne(r, i)
+j = (r) .ne. i        ! <intrinsic> ne(r, i)
+
+! Nested access: struct has a member eq which has a member i
+j =  struct .eq. i    ! struct%eq%i
+if ( j .ne. struct%eq%i ) call abort()
+
+! User op: struct is compared to i with eq_func
+j = (struct) .eq. i   ! eq_func(struct, i) -> struct%eq%i + i
+if ( j .ne. struct%eq%i + i ) call abort()
+
+! User op: struct has a member test which has a member i, but test is a uop
+j =  struct .test. i  ! tstfunc(struct, i) -> struct%i + i
+if ( j .ne. struct%i + i ) call abort()
+
+! User op: struct is compared to i with eq_func
+j = (struct) .test. i ! tstfunc(struct, i) -> struct%i + i
+if ( j .ne. struct%i + i ) call abort()
+
+! Deep nested access tests
+r7.r6.r5.r4.r3.r2.i = 1337
+j = r7.r6.r5.r4.r3.r2.i
+if ( j .ne. 1337 ) call abort()
+
+end
diff --git a/gcc/testsuite/gfortran.dg/dec_structure_11.f90 b/gcc/testsuite/gfortran.dg/dec_structure_11.f90
new file mode 100644
index 0000000..f6f5b6f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_structure_11.f90
@@ -0,0 +1,20 @@
+! { dg-do compile }
+! { dg-options "-fdec-structure" }
+!
+! Tests for what CAN'T be done with dot ('.') as a member accessor.
+!
+
+structure /s1/
+  integer eq
+end structure
+
+record /s1/ r
+integer i, j, k
+
+j = i.j          ! { dg-error "nonderived-type variable" }
+j = r .eq. i     ! { dg-error "Operands of comparison" }
+j = r.i          ! { dg-error "is not a member of" }
+j = r.           ! { dg-error "Expected structure component or operator name" }
+j = .i           ! { dg-error "Invalid character in name" }
+
+end
diff --git a/gcc/testsuite/gfortran.dg/dec_structure_2.f90 b/gcc/testsuite/gfortran.dg/dec_structure_2.f90
new file mode 100644
index 0000000..18db719
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_structure_2.f90
@@ -0,0 +1,41 @@
+! { dg-do run }
+! { dg-options "-fdec-structure" }
+!
+! Test STRUCTUREs containin other STRUCTUREs.
+!
+
+subroutine aborts (s)
+  character(*), intent(in) :: s
+  print *, s
+  call abort()
+end subroutine
+
+! Basic structure
+structure /s1/
+  integer i1
+  logical l1
+  real r1
+  character c1
+end structure
+
+structure /s2/
+  integer i
+  record /s1/ r1
+endstructure
+
+record /s1/ r1
+record /s2/ r2, r2_a(10)
+
+! Nested and array records
+r2.r1.r1 = 135.79
+r2_a(3).r1.i1 = -13579
+
+if (r2.r1.r1 .ne. 135.79) then
+  call aborts("r1.r1.r1")
+endif
+
+if (r2_a(3).r1.i1 .ne. -13579) then
+  call aborts("r2_a(3).r1.i1")
+endif
+
+end
diff --git a/gcc/testsuite/gfortran.dg/dec_structure_3.f90 b/gcc/testsuite/gfortran.dg/dec_structure_3.f90
new file mode 100644
index 0000000..9cb7adb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_structure_3.f90
@@ -0,0 +1,52 @@
+! { dg-do run }
+! { dg-options "-fdec-structure" }
+!
+! Test nested STRUCTURE definitions.
+!
+
+subroutine aborts (s)
+  character(*), intent(in) :: s
+  print *, s
+  call abort()
+end subroutine
+
+structure /s3/
+  real p
+  structure /s4/ recrd, recrd_a(3)
+    integer i, j
+  end structure
+  real q
+end structure
+
+record /s3/ r3
+record /s4/ r4
+
+r3.p = 1.3579
+r4.i = 0
+r4.j = 1
+r3.recrd = r4
+r3.recrd_a(1) = r3.recrd
+r3.recrd_a(2).i = 1
+r3.recrd_a(2).j = 0
+
+if (r3.p .ne. 1.3579) then
+  call aborts("r3.p")
+endif
+
+if (r4.i .ne. 0) then
+  call aborts("r4.i")
+endif
+
+if (r4.j .ne. 1) then
+  call aborts("r4.j")
+endif
+
+if (r3.recrd.i .ne. 0 .or. r3.recrd.j .ne. 1) then
+  call aborts("r3.recrd")
+endif
+
+if (r3.recrd_a(2).i .ne. 1 .or. r3.recrd_a(2).j .ne. 0) then
+  call aborts("r3.recrd_a(2)")
+endif
+
+end
diff --git a/gcc/testsuite/gfortran.dg/dec_structure_4.f90 b/gcc/testsuite/gfortran.dg/dec_structure_4.f90
new file mode 100644
index 0000000..a941c22
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_structure_4.f90
@@ -0,0 +1,43 @@
+! { dg-do run }
+! { dg-options "-fdec-structure" }
+!
+! Test anonymous STRUCTURE definitions.
+!
+
+subroutine aborts (s)
+  character(*), intent(in) :: s
+  print *, s
+  call abort()
+end subroutine
+
+structure /s5/
+  structure recrd, recrd_a(3)
+    real x, y
+  end structure
+end structure
+
+record /s5/ r5
+
+r5.recrd.x = 1.3
+r5.recrd.y = 5.7
+r5.recrd_a(1) = r5.recrd
+r5.recrd_a(2).x = 5.7
+r5.recrd_a(2).y = 1.3
+
+if (r5.recrd.x .ne. 1.3) then
+  call aborts("r5.recrd.x")
+endif
+
+if (r5.recrd.y .ne. 5.7) then
+  call aborts("r5.recrd.y")
+endif
+
+if (r5.recrd_a(1).x .ne. 1.3 .or. r5.recrd_a(1).y .ne. 5.7) then
+  call aborts("r5.recrd_a(1)")
+endif
+
+if (r5.recrd_a(2).x .ne. 5.7 .or. r5.recrd_a(2).y .ne. 1.3) then
+  call aborts("r5.recrd_a(2)")
+endif
+
+end
diff --git a/gcc/testsuite/gfortran.dg/dec_structure_5.f90 b/gcc/testsuite/gfortran.dg/dec_structure_5.f90
new file mode 100644
index 0000000..abda3c3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_structure_5.f90
@@ -0,0 +1,49 @@
+! { dg-do run }
+! { dg-options "-fdec-structure" }
+!
+! Test STRUCTUREs which share names with variables.
+!
+
+subroutine aborts (s)
+  character(*), intent(in) :: s
+  print *, s
+  call abort()
+end subroutine
+
+! Special regression where shared names within a module caused an ICE
+! from gfc_get_module_backend_decl
+module dec_structure_5m
+  structure /s6/
+    integer i
+  end structure
+
+  record /s6/ s6
+end module
+
+program dec_structure_5
+  use dec_structure_5m
+
+  structure /s7/
+    real r
+  end structure
+
+  record /s7/ s7(3)
+
+  s6.i = 0
+  s7(1).r = 1.0
+  s7(2).r = 2.0
+  s7(3).r = 3.0
+
+  if (s6.i .ne. 0) then
+    call aborts("s6.i")
+  endif
+
+  if (s7(1).r .ne. 1.0) then
+    call aborts("s7(1).r")
+  endif
+
+  if (s7(2).r .ne. 2.0) then
+    call aborts("s7(2).r")
+  endif
+
+end
diff --git a/gcc/testsuite/gfortran.dg/dec_structure_6.f90 b/gcc/testsuite/gfortran.dg/dec_structure_6.f90
new file mode 100644
index 0000000..6494d71
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_structure_6.f90
@@ -0,0 +1,46 @@
+! { dg-do run }
+! { dg-options "-fdec-structure" }
+!
+! Test old-style CLIST initializers in STRUCTURE.
+!
+
+subroutine aborts (s)
+  character(*), intent(in) :: s
+  print *, s
+  call abort()
+end subroutine
+
+integer, parameter :: as = 3
+structure /s8/
+  character*20 c /"HELLO"/  ! ok
+  integer*2 j /300_4/       ! ok, converted
+  integer   k /65536_8/     ! ok, implicit
+  integer*4 l /200000/      ! ok, types match
+  integer   m(5) /5,4,3,2,1/! ok
+  integer   n(5) /1,3*2,1/  ! ok, with repeat spec (/1,2,2,2,1/)
+  integer   o(as) /as*9/    ! ok, parameter array spec
+  integer   p(2,2) /1,2,3,4/! ok
+  real      q(3) /1_2,3.5,2.4E-12_8/ ! ok, with some implicit conversions
+  integer :: canary = z'3D3D3D3D'
+end structure
+
+record /s8/ r8
+
+! Old-style (clist) initializers in structures
+if ( r8.c /= "HELLO" ) call aborts ("r8.c")
+if ( r8.j /= 300 ) call aborts ("r8.j")
+if ( r8.k /= 65536 ) call aborts ("r8.k")
+if ( r8.l /= 200000 ) call aborts ("r8.l")
+if (     r8.m(1) /= 5 .or. r8.m(2) /= 4 .or. r8.m(3) /= 3 &
+    .or. r8.m(4) /= 2 .or. r8.m(5) /= 1) &
+  call aborts ("r8.m")
+if (     r8.n(1) /= 1 .or. r8.n(2) /= 2 .or. r8.n(3) /= 2 .or. r8.n(4) /= 2 &
+    .or. r8.n(5) /= 1) &
+  call aborts ("r8.n")
+if ( r8.o(1) /= 9 .or. r8.o(2) /= 9 .or. r8.o(3) /= 9 ) call aborts ("r8.o")
+if (     r8.p(1,1) /= 1 .or. r8.p(2,1) /= 2 .or. r8.p(1,2) /= 3 &
+    .or. r8.p(2,2) /= 4) &
+  call aborts ("r8.p")
+if ( r8.canary /= z'3D3D3D3D' ) call aborts ("r8.canary")
+
+end
diff --git a/gcc/testsuite/gfortran.dg/dec_structure_7.f90 b/gcc/testsuite/gfortran.dg/dec_structure_7.f90
new file mode 100644
index 0000000..baba1ef
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_structure_7.f90
@@ -0,0 +1,75 @@
+! { dg-do run }
+! { dg-options "-fdec-structure" }
+!
+! Test passing STRUCTUREs through functions and subroutines.
+!
+
+subroutine aborts (s)
+  character(*), intent(in) :: s
+  print *, s
+  call abort()
+end subroutine
+
+module dec_structure_7m
+  structure /s1/
+    integer i1
+    logical l1
+    real r1
+    character c1
+  end structure
+
+  structure /s2/
+    integer i
+    record /s1/ r1
+  endstructure
+
+contains
+  ! Pass structure through subroutine
+  subroutine sub (rec1, i)
+    implicit none
+    integer, intent(in) :: i
+    record /s1/ rec1
+    rec1.i1 = i
+  end subroutine
+
+  ! Pass structure through function
+  function func (rec2, r)
+    implicit none
+    real, intent(in) :: r
+    record /s2/ rec2
+    real func
+    rec2.r1.r1 = r
+    func = rec2.r1.r1
+    return
+  end function
+end module
+
+program dec_structure_7
+  use dec_structure_7m
+
+  implicit none
+  record /s1/ r1
+  record /s2/ r2
+  real junk
+
+  ! Passing through functions and subroutines
+  r1.i1 = 0
+  call sub (r1, 10)
+
+  r2.r1.r1 = 0.0
+  junk = func (r2, -20.14)
+
+  if (r1.i1 .ne. 10) then
+    call aborts("sub(r1, 10)")
+  endif
+
+  if (r2.r1.r1 .ne. -20.14) then
+    call aborts("func(r2, -20.14)")
+  endif
+
+  if (junk .ne. -20.14) then
+    print *, junk
+    call aborts("junk = func()")
+  endif
+
+end program
diff --git a/gcc/testsuite/gfortran.dg/dec_structure_8.f90 b/gcc/testsuite/gfortran.dg/dec_structure_8.f90
new file mode 100644
index 0000000..160b92a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_structure_8.f90
@@ -0,0 +1,60 @@
+! { dg-do compile }
+! { dg-options "-fdec-structure -fmax-errors=0" }
+!
+! Comprehensive compile tests for what structures CAN'T do.
+!
+
+! Old-style (clist) initialization
+integer,parameter :: as = 3
+structure /t1/
+  integer*1 a /300_2/       ! { dg-error "Arithmetic overflow" }
+  integer   b //            ! { dg-error "Empty old style initializer list" }
+  integer   c /2*3/         ! { dg-error "Repeat spec invalid in scalar" }
+  integer   d /1,2,3/       ! { dg-error "End of scalar initializer expected" }
+  integer   e /"HI"/        ! { dg-error "Can't convert" }
+  integer   f(as) /4*9/     ! { dg-error "Too many elements" }
+  integer   g(3) /1,3/      ! { dg-error "Not enough elements" }
+  integer   h(3) /1,3,5,7/  ! { dg-error "Too many elements" }
+  integer   i(3) /2*1/      ! { dg-error "Not enough elements" }
+  integer   j(3) /10*1/     ! { dg-error "Too many elements" }
+  integer   k(3) /2.5*3/    ! { dg-error "Repeat spec must be an integer" }
+  integer   l(2) /2*/       ! { dg-error "Expected data constant" }
+  integer   m(1) /          ! { dg-error "Syntax error in old style" }
+  integer   n(2) /1         ! { dg-error "Syntax error in old style" }
+  integer   o(2) /1,        ! { dg-error "Syntax error in old style" }
+  integer   p(1) /x/        ! { dg-error "must be a PARAMETER" }
+end structure
+
+structure              ! { dg-error "Structure name expected" }
+structure /            ! { dg-error "Structure name expected" }
+structure //           ! { dg-error "Structure name expected" }
+structure /.or./       ! { dg-error "Structure name expected" }
+structure /integer/    ! { dg-error "Structure name.*cannot be the same" }
+structure /foo/ bar    ! { dg-error "Junk after" }
+structure /t1/         ! { dg-error "Type definition.*T1" }
+
+record                 ! { dg-error "Structure name expected" }
+record bar             ! { dg-error "Structure name expected" }
+record / bar           ! { dg-error "Structure name expected" }
+record // bar          ! { dg-error "Structure name expected" }
+record foo/ bar        ! { dg-error "Structure name expected" }
+record /foo bar        ! { dg-error "Structure name expected" }
+record /foo/ bar       ! { dg-error "used before it is defined" }
+record /t1/            ! { dg-error "Invalid character in name" }
+
+structure /t2/
+  ENTRY here           ! { dg-error "ENTRY statement.*cannot appear" }
+  integer a
+  integer a            ! { dg-error "Component.*already declared" }
+  structure $z         ! { dg-error "Invalid character in name" }
+  structure //         ! { dg-error "Invalid character in name" }
+  structure // x       ! { dg-error "Invalid character in name" }
+  structure /t3/       ! { dg-error "Invalid character in name" }
+  structure /t3/ x,$y  ! { dg-error "Invalid character in name" }
+  structure /t4/ y
+    integer i, j, k
+  end structure
+  structure /t4/ z     ! { dg-error "Type definition.*T4" }
+end structure
+
+end
diff --git a/gcc/testsuite/gfortran.dg/dec_structure_9.f90 b/gcc/testsuite/gfortran.dg/dec_structure_9.f90
new file mode 100644
index 0000000..34c46c6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_structure_9.f90
@@ -0,0 +1,42 @@
+! { dg-do compile }
+! { dg-options "-fdec-structure" }
+!
+! Basic compile tests for what CAN be done with dot ('.') as a member accessor.
+!
+
+logical :: l, l2 = .true., l3 = .false., and
+integer i
+character(5) s
+real r
+
+structure /s1/
+  integer i
+  character(5) s
+  real r
+end structure
+
+record /s1/ r1
+
+! Basic 
+l = l .and. l2 .or. l3
+l = and .and. and .and. and
+l =  l2 .eqv. l3
+l = (l2) .eqv. l3
+
+! Integers
+l = .not. (i .eq. 0)
+l = .not. (0 .eq. i)
+l = .not. (r1.i .eq. 0)
+l = .not. (0 .eq. r1.i)
+! Characters
+l = .not. (s .eq. "hello")
+l = .not. ("hello" .eq. s)
+l = .not. (r1.s .eq. "hello")
+l = .not. ("hello" .eq. r1.s)
+! Reals
+l = .not. (r .eq. 3.14)
+l = .not. (3.14 .eq. r)
+l = .not. (r1.r .eq. 3.14)
+l = .not. (3.14 .eq. r1.r)
+
+end
diff --git a/gcc/testsuite/gfortran.dg/dec_union_1.f90 b/gcc/testsuite/gfortran.dg/dec_union_1.f90
new file mode 100644
index 0000000..36af53a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_union_1.f90
@@ -0,0 +1,66 @@
+! { dg-do run }
+! { dg-options "-fdec-structure" }
+!
+! Test whether union backend declarations are corrently _not_ copied when they
+! are not in fact equal. The structure defined in sub() is seen later, but
+! where siz has a different value.
+!
+
+subroutine aborts (s)
+  character(*), intent(in) :: s
+  print *, s
+  call abort()
+end subroutine
+
+subroutine sub ()
+  integer, parameter :: siz = 1024
+  structure /s6/
+    union ! U0
+      map ! M0
+        integer ibuf(siz)
+      end map
+      map ! M1
+        character(8) cbuf(siz)
+      end map
+      map ! M2
+        real rbuf(siz)
+      end map
+    end union
+  end structure
+  record /s6/ r6
+  r6.ibuf(1) = z'badbeef'
+  r6.ibuf(2) = z'badbeef'
+end subroutine
+
+! Repeat definition from subroutine sub with different size parameter.
+! If the structure definition is copied here the stack may get messed up.
+integer, parameter :: siz = 65536
+structure /s6/
+  union ! U12
+    map
+      integer ibuf(siz)
+    end map
+    map
+      character(8) cbuf(siz)
+    end map
+    map
+      real rbuf(siz)
+    end map
+  end union
+end structure
+
+record /s6/ r6
+integer :: r6_canary = 0
+
+! Copied type declaration - this should not cause problems
+i = 1
+do while (i < siz)
+  r6.ibuf(i) = z'badbeef'
+  i = i + 1
+end do
+
+if ( r6_canary .ne. 0 ) then
+  call aborts ('copied decls: overflow')
+endif
+
+end
diff --git a/gcc/testsuite/gfortran.dg/dec_union_2.f90 b/gcc/testsuite/gfortran.dg/dec_union_2.f90
new file mode 100644
index 0000000..61e4fd8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_union_2.f90
@@ -0,0 +1,60 @@
+! { dg-do run }
+! { dg-options "-fdec-structure" }
+!
+! Test basic UNION implementation.
+!
+
+subroutine aborts (s)
+  character(*), intent(in) :: s
+  print *, s
+  call abort()
+end subroutine
+
+! Empty union
+structure /s0/
+  union ! U0
+    map ! M0
+    end map
+    map ! M1
+    end map
+  end union
+end structure
+
+! Basic unions
+structure /s1/
+  union ! U1
+    map ! M2
+      integer(4) a
+    end map
+    map ! M3
+      real(4) b
+    end map
+  end union
+end structure
+structure /s2/
+  union ! U2
+    map ! M4
+      integer(2) w1, w2
+    end map
+    map ! M5
+      integer(4) long
+    end map
+  end union
+end structure
+
+record /s1/ r1
+record /s2/ r2
+
+! Basic unions
+r1.a = 0
+r1.b = 1.33e7
+if ( r1.a .eq. 0 ) call aborts ("basic union 1")
+
+! Endian-agnostic runtime check
+r2.long = z'12345678'
+if (.not. (     (r2.w1 .eq. z'1234' .and. r2.w2 .eq. z'5678') &
+           .or. (r2.w1 .eq. z'5678' .and. r2.w2 .eq. z'1234')) ) then
+    call aborts ("basic union 2")
+endif
+
+end
diff --git a/gcc/testsuite/gfortran.dg/dec_union_3.f90 b/gcc/testsuite/gfortran.dg/dec_union_3.f90
new file mode 100644
index 0000000..ce5ae79
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_union_3.f90
@@ -0,0 +1,35 @@
+! { dg-do run }
+! { dg-options "-fdec-structure" }
+!
+! Test UNIONs with initializations.
+!
+
+subroutine aborts (s)
+  character(*), intent(in) :: s
+  print *, s
+  call abort()
+end subroutine
+
+! Initialization expressions
+structure /s3/
+  integer(4) :: i = 8
+  union ! U7
+    map
+      integer(4) :: x = 1600
+      integer(4) :: y = 1800
+    end map
+    map
+      integer(2) a, b, c
+    end map
+  end union
+end structure
+
+record /s3/ r3
+
+! Initialized unions
+if ( r3.x .ne. 1600 .or. r3.y .ne. 1800) then
+  r3.x = r3.y ! If r3 isn't used the initializations are optimized out
+  call aborts ("union initialization")
+endif
+
+end
diff --git a/gcc/testsuite/gfortran.dg/dec_union_4.f90 b/gcc/testsuite/gfortran.dg/dec_union_4.f90
new file mode 100644
index 0000000..3bf6d61
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_union_4.f90
@@ -0,0 +1,62 @@
+! { dg-do run }
+! { dg-options "-fdec-structure" }
+!
+! Test nested UNIONs.
+!
+
+subroutine aborts (s)
+  character(*), intent(in) :: s
+  print *, s
+  call abort()
+end subroutine
+
+! Nested unions
+structure /s4/
+  union ! U0                ! rax
+    map
+      integer(8) rx
+    end map
+    map
+      integer(4) rh         ! rah
+      union ! U1
+        map
+          integer(4) rl     ! ral
+        end map
+        map
+          integer(4) ex     ! eax
+        end map
+        map
+          integer(2) eh     ! eah
+          union ! U2
+            map
+              integer(2) el ! eal
+            end map
+            map
+              integer(2) x  ! ax
+            end map
+            map
+              integer(1) h  ! ah
+              integer(1) l  ! al
+            end map
+          end union
+        end map
+      end union
+    end map
+  end union
+end structure
+record /s4/ r4
+
+
+! Nested unions
+r4.rx     =     z'7A7B7CCC7FFFFFFF'
+if ( r4.rx .ne. z'7A7B7CCC7FFFFFFF' ) call aborts ("rax")
+if ( r4.rh .ne.         z'7FFFFFFF' ) call aborts ("rah")
+if ( r4.rl .ne. z'7A7B7CCC'         ) call aborts ("ral")
+if ( r4.ex .ne. z'7A7B7CCC'         ) call aborts ("eax")
+if ( r4.eh .ne.     z'7CCC'         ) call aborts ("eah")
+if ( r4.el .ne. z'7A7B'             ) call aborts ("eal")
+if ( r4.x  .ne. z'7A7B'             ) call aborts ("ax")
+if ( r4.h  .ne.   z'7B'             ) call aborts ("ah")
+if ( r4.l  .ne. z'7A'               ) call aborts ("al")
+
+end
diff --git a/gcc/testsuite/gfortran.dg/dec_union_5.f90 b/gcc/testsuite/gfortran.dg/dec_union_5.f90
new file mode 100644
index 0000000..bb1611a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_union_5.f90
@@ -0,0 +1,41 @@
+! { dg-do run }
+! { dg-options "-fdec-structure" }
+!
+! Test UNIONs with array components.
+!
+
+subroutine aborts (s)
+  character(*), intent(in) :: s
+  print *, s
+  call abort()
+end subroutine
+
+! Unions with arrays
+structure /s5/
+  union
+    map
+      character :: s(5)
+    end map
+    map
+      integer(1) :: a(5)
+    end map
+  end union
+end structure
+
+record /s5/ r5
+
+! Unions with arrays
+r5.a(1) = z'41'
+r5.a(2) = z'42'
+r5.a(3) = z'43'
+r5.a(4) = z'44'
+r5.a(5) = z'45'
+if (     r5.s(1) .ne. 'A' &
+    .or. r5.s(2) .ne. 'B' &
+    .or. r5.s(3) .ne. 'C' &
+    .or. r5.s(4) .ne. 'D' &
+    .or. r5.s(5) .ne. 'E') then
+  call aborts ("arrays")
+endif
+
+end
diff --git a/gcc/testsuite/gfortran.dg/dec_union_6.f90 b/gcc/testsuite/gfortran.dg/dec_union_6.f90
new file mode 100644
index 0000000..31059c4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_union_6.f90
@@ -0,0 +1,59 @@
+! { dg-do run }
+! { dg-options "-fdec-structure" }
+!
+! sub0 and sub1 test a regression where calling gfc_use_derived from
+! gfc_find_component on the structure type symbol being parsed caused the
+! symbol to be freed and swapped for the previously seen type symbol, leaving
+! dangling pointers and causing all sorts of mayhem.
+!
+
+subroutine sub0 (u)
+  structure /s/
+    union ! U0
+      map ! M0
+        integer i
+      end map
+    end union
+  end structure
+  record /s/ u
+  u.i = 0
+end subroutine sub0
+
+subroutine sub1 ()
+  structure /s/
+    union ! U1
+      map ! M1
+        integer i
+      end map
+    end union
+  end structure
+  record /s/ u
+  interface ! matches the declaration of sub0 above
+    subroutine sub0 (u)
+      structure /s/
+        union ! U2
+          map ! M2
+            integer i ! gfc_find_component should not call gfc_use_derived
+          end map     ! here, otherwise this structure's type symbol is freed
+        end union     ! out from under it
+      end structure
+      record /s/ u
+    end subroutine sub0
+  end interface
+  call sub0(u)
+end subroutine
+
+! If sub0 and sub1 aren't used they may be omitted
+structure /s/
+  union ! U1
+    map ! M3
+      integer i
+    end map
+  end union
+end structure
+record /s/ u
+
+call sub0(u)
+call sub1()
+
+end
diff --git a/gcc/testsuite/gfortran.dg/dec_union_7.f90 b/gcc/testsuite/gfortran.dg/dec_union_7.f90
new file mode 100644
index 0000000..270f0fb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_union_7.f90
@@ -0,0 +1,38 @@
+! { dg-do compile }
+! { dg-options "-fdec-structure" }
+!
+! Comprehensive compile tests for what unions CAN'T do.
+!
+
+! Syntax errors
+structure /s0/
+  union a b c      ! { dg-error "Junk after UNION" }
+  union
+    map a b c      ! { dg-error "Junk after MAP" }
+    integer x      ! { dg-error "Unexpected" }
+    structure /s2/ ! { dg-error "Unexpected" }
+    map
+      map          ! { dg-error "Unexpected" }
+    end map
+  end union
+end structure
+
+! Initialization expressions
+structure /s1/
+  union
+    map
+      integer(4) :: x = 1600 ! { dg-error "Conflicting initializers" }
+      integer(4) :: y = 1800
+    end map
+    map
+      integer(2) a, b, c, d
+      integer :: e = 0 ! { dg-error "Conflicting initializers" }
+    end map
+    map
+      real :: p = 1.3, q = 3.7 ! { dg-error "Conflicting initializers" }
+    end map
+  end union
+end structure
+record /s1/ r1
+
+end